Changeset 84 for trunk/NEMO
- Timestamp:
- 2004-04-22T15:32:41+02:00 (20 years ago)
- Location:
- trunk/NEMO/OPA_SRC
- Files:
-
- 21 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DIA/diafwb.F90
r32 r84 109 109 IF( lk_mpp ) CALL mpp_sum( a_rnf ) ! sum over the global domain 110 110 111 IF( aminus /= 0. 0 ) a_aminus = a_aminus + ( MIN( aplus, aminus ) / aminus )112 IF( aplus /= 0. 0 ) a_aplus = a_aplus + ( MIN( aplus, aminus ) / aplus )111 IF( aminus /= 0.e0 ) a_aminus = a_aminus + ( MIN( aplus, aminus ) / aminus ) 112 IF( aplus /= 0.e0 ) a_aplus = a_aplus + ( MIN( aplus, aminus ) / aplus ) 113 113 114 114 IF( kt == nitend ) THEN … … 205 205 zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) 206 206 207 IF( un(ji,jj,jk) > 0. 0 ) THEN207 IF( un(ji,jj,jk) > 0.e0 ) THEN 208 208 zflxi(1) = zflxi(1) + zu 209 209 ztemi(1) = ztemi(1) + zt*zu … … 245 245 zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) 246 246 247 IF( un(ji,jj,jk) > 0. 0 ) THEN247 IF( un(ji,jj,jk) > 0.e0 ) THEN 248 248 zflxi(2) = zflxi(2) + zu 249 249 ztemi(2) = ztemi(2) + zt*zu … … 285 285 zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) 286 286 287 IF( un(ji,jj,jk) > 0. 0 ) THEN287 IF( un(ji,jj,jk) > 0.e0 ) THEN 288 288 zflxi(3) = zflxi(3) + zu 289 289 ztemi(3) = ztemi(3) + zt*zu … … 325 325 zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) 326 326 327 IF( un(ji,jj,jk) > 0. 0 ) THEN327 IF( un(ji,jj,jk) > 0.e0 ) THEN 328 328 zflxi(4) = zflxi(4) + zu 329 329 ztemi(4) = ztemi(4) + zt*zu … … 338 338 ! Sum at each time-step 339 339 DO jt = 1, 4 340 IF( zflxi(jt) /= 0. 0 .AND. zflxo(jt) /= 0.0 ) THEN340 IF( zflxi(jt) /= 0.e0 .AND. zflxo(jt) /= 0.e0 ) THEN 341 341 a_flxi(jt) = a_flxi(jt) + zflxi(jt) 342 342 a_temi(jt) = a_temi(jt) + ztemi(jt)/zflxi(jt) … … 350 350 IF( kt == nitend ) THEN 351 351 DO jt = 1, 4 352 a_flxi(jt) = a_flxi(jt) /((nitend-nit000+1)*1.e6)353 a_temi(jt) = a_temi(jt) /( nitend-nit000+1)354 a_sali(jt) = a_sali(jt) /( nitend-nit000+1)355 a_flxo(jt) = a_flxo(jt) /((nitend-nit000+1)*1.e6)356 a_temo(jt) = a_temo(jt) /( nitend-nit000+1)357 a_salo(jt) = a_salo(jt) /( nitend-nit000+1)352 a_flxi(jt) = a_flxi(jt) / ( FLOAT( nitend - nit000 + 1 ) * 1.e6 ) 353 a_temi(jt) = a_temi(jt) / FLOAT( nitend - nit000 + 1 ) 354 a_sali(jt) = a_sali(jt) / FLOAT( nitend - nit000 + 1 ) 355 a_flxo(jt) = a_flxo(jt) / ( FLOAT( nitend - nit000 + 1 ) * 1.e6 ) 356 a_temo(jt) = a_temo(jt) / FLOAT( nitend - nit000 + 1 ) 357 a_salo(jt) = a_salo(jt) / FLOAT( nitend - nit000 + 1 ) 358 358 END DO 359 359 ENDIF … … 368 368 WRITE(111,*) 369 369 WRITE(111,*) 'Net freshwater budget ' 370 WRITE(111,9010) ' emp = ',a_emp, ' m3 =', a_emp /( (nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv'371 WRITE(111,9010) ' precip = ',a_precip,' m3 =', a_precip/( (nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv'372 WRITE(111,9010) ' a_rnf = ',a_rnf, ' m3 =', a_rnf /((nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv'370 WRITE(111,9010) ' emp = ',a_emp, ' m3 =', a_emp /(FLOAT(nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv' 371 WRITE(111,9010) ' precip = ',a_precip,' m3 =', a_precip/(FLOAT(nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv' 372 WRITE(111,9010) ' a_rnf = ',a_rnf, ' m3 =', a_rnf /(FLOAT(nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv' 373 373 WRITE(111,*) 374 374 WRITE(111,9010) ' zarea =',zarea … … 378 378 WRITE(111,9010) ' at nit000 = ',a_sshb ,' m3 ' 379 379 WRITE(111,9010) ' at nitend = ',a_sshn ,' m3 ' 380 WRITE(111,9010) ' diff = ',(a_sshn-a_sshb),' m3 =', (a_sshn-a_sshb)/( (nitend-nit000+1)*rdt) * 1.e-6,' Sv'380 WRITE(111,9010) ' diff = ',(a_sshn-a_sshb),' m3 =', (a_sshn-a_sshb)/(FLOAT(nitend-nit000+1)*rdt) * 1.e-6,' Sv' 381 381 WRITE(111,9020) ' mean sea level elevation =', a_sshn/zarea,' m' 382 382 WRITE(111,*) -
trunk/NEMO/OPA_SRC/DIA/diawri.F90
r23 r84 364 364 CALL histdef( nid_W,"voddmavs","Salt Vertical Eddy Diffusivity" , "m2/s" , & ! avs 365 365 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 366 CALL histdef( nid_W,"voddmrra","Heat/Salt buoyancy Ratio" , "-" , & ! rrau367 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )368 366 ENDIF 369 367 ! !!! nid_W : 2D -
trunk/NEMO/OPA_SRC/DOM/domwri.F90
r3 r84 6 6 7 7 !!---------------------------------------------------------------------- 8 !! dom_wri : create mesh and mask file(s)8 !! dom_wri : create and write mesh and mask file(s) 9 9 !! nmsh = 1 : mesh_mask file 10 10 !! = 2 : mesh and mask file -
trunk/NEMO/OPA_SRC/DTA/dtasst.F90
r16 r84 96 96 IF(lwp) WRITE(numout,*) 'dta_sst : DAILY sea surface temperature data' 97 97 IF(lwp) WRITE(numout,*) '~~~~~~~ read in file: ', clname 98 sst(:,:) = 0.e0 ! required for extra halos in mpp 98 99 ENDIF 99 100 -
trunk/NEMO/OPA_SRC/DYN/dynhpg.F90
r32 r84 162 162 END DO 163 163 164 IF( l_ctl .AND. lwp) THEN ! print sum trends (used for debugging)164 IF(l_ctl) THEN ! print sum trends (used for debugging) 165 165 zuap = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 166 166 zvap = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) … … 317 317 END DO 318 318 319 IF( l_ctl .AND. lwp) THEN ! print sum trends (used for debugging)319 IF(l_ctl) THEN ! print sum trends (used for debugging) 320 320 zuap = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 321 321 zvap = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) … … 428 428 END DO 429 429 430 IF( l_ctl .AND. lwp) THEN ! print sum trends (used for debugging)430 IF(l_ctl) THEN ! print sum trends (used for debugging) 431 431 zuap = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 432 432 zvap = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) -
trunk/NEMO/OPA_SRC/DYN/dynhpg_atsk.F90
r32 r84 150 150 ! ! =============== 151 151 152 IF( l_ctl .AND. lwp) THEN ! print sum trends (used for debugging)152 IF(l_ctl) THEN ! print sum trends (used for debugging) 153 153 zuap = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 154 154 zvap = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) … … 295 295 END DO ! End of slab 296 296 ! ! =============== 297 298 IF(l_ctl) THEN ! print sum trends (used for debugging) 299 zuap = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 300 zvap = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 301 WRITE(numout,*) ' hpg - Ua: ', zuap-u_ctl, ' Va: ', zvap-v_ctl 302 u_ctl = zuap ; v_ctl = zvap 303 ENDIF 304 297 305 END SUBROUTINE dyn_hpg_atsk 298 306 … … 402 410 ! ! =============== 403 411 404 IF( l_ctl .AND. lwp) THEN ! print sum trends (used for debugging)412 IF(l_ctl) THEN ! print sum trends (used for debugging) 405 413 WRITE(numout,*) ' hpg - Ua: ', SUM(ua*umask), ' Va: ', SUM(va*vmask) 406 414 zuap = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) -
trunk/NEMO/OPA_SRC/DYN/dynkeg.F90
r3 r84 119 119 ! ! =============== 120 120 121 IF( l_ctl .AND. lwp) THEN ! print sum trends (used for debugging)121 IF(l_ctl) THEN ! print sum trends (used for debugging) 122 122 zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 123 123 zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) -
trunk/NEMO/OPA_SRC/DYN/dynldf_bilap.F90
r3 r84 219 219 END DO ! End of slab 220 220 ! ! =============== 221 222 IF(l_ctl) THEN ! print sum trends (used for debugging) 223 zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 224 zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 225 WRITE(numout,*) ' ldf - Ua: ', zua-u_ctl, ' Va: ', zva-v_ctl 226 u_ctl = zua ; v_ctl = zva 227 ENDIF 228 221 229 END SUBROUTINE dyn_ldf_bilap 222 230 -
trunk/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
r32 r84 73 73 !! * Local declarations 74 74 INTEGER :: ji, jj, jk ! dummy loop indices 75 REAL(wp) :: zua, zva ! temporary scalars 75 76 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 76 77 wk1, wk2, & ! work array used for rotated biharmonic … … 126 127 END DO ! End of slab 127 128 ! ! =============== 129 130 IF(l_ctl) THEN ! print sum trends (used for debugging) 131 zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 132 zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 133 WRITE(numout,*) ' ldf - Ua: ', zua-u_ctl, ' Va: ', zva-v_ctl 134 u_ctl = zua ; v_ctl = zva 135 ENDIF 128 136 129 137 END SUBROUTINE dyn_ldf_bilapg -
trunk/NEMO/OPA_SRC/DYN/dynldf_lap.F90
r3 r84 118 118 ! ! =============== 119 119 120 IF( l_ctl .AND. lwp) THEN ! print sum trends (used for debugging)120 IF(l_ctl) THEN ! print sum trends (used for debugging) 121 121 zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 122 122 zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) -
trunk/NEMO/OPA_SRC/DYN/dynnxt.F90
r32 r84 133 133 ! ! =============== 134 134 135 IF( l_ctl .AND. lwp ) THEN ! print sum fields (used for debugging) 136 WRITE(numout,*) ' nxt - Un: ', SUM(un*umask), ' Vn: ', SUM(vn*vmask) 137 ENDIF 135 IF(l_ctl) WRITE(numout,*) ' nxt - Un: ', SUM(un*umask), ' Vn: ', SUM(vn*vmask) 138 136 139 137 END SUBROUTINE dyn_nxt -
trunk/NEMO/OPA_SRC/DYN/dynspg_fsc.F90
r31 r84 347 347 END DO 348 348 349 IF( l_ctl .AND. lwp) THEN ! print sum trends (used for debugging)349 IF(l_ctl) THEN ! print sum trends (used for debugging) 350 350 WRITE(numout,*) ' spg - Ua: ', SUM( ua(2:jpim1,2:jpjm1,1:jpkm1)*umask(2:jpim1,2:jpjm1,1:jpkm1) ), & 351 351 & ' Va: ', SUM( va(2:jpim1,2:jpjm1,1:jpkm1)*vmask(2:jpim1,2:jpjm1,1:jpkm1) ) -
trunk/NEMO/OPA_SRC/DYN/dynspg_fsc_atsk.F90
r31 r84 18 18 USE oce ! ocean dynamics and tracers 19 19 USE dom_oce ! ocean space and time domain 20 USE trdtra_oce ! ocean active tracer trend 21 USE trddyn_oce ! ocean dynamics trend 20 USE zdf_oce ! ocean vertical physics 21 USE trdtra_oce ! ocean active tracer trend 22 USE trddyn_oce ! ocean dynamics trend 22 23 USE in_out_manager ! I/O manager 23 24 USE phycst ! physical constant 24 USE ocesbc ! Oce n Surface Boundary condition25 USE ocesbc ! Ocean Surface Boundary condition 25 26 USE flxrnf ! ??? 26 27 USE sol_oce ! ocean elliptic solver … … 30 31 USE obc_oce ! Lateral open boundary condition 31 32 USE obcdyn ! open boudary condition 32 USE obcdyn ! " "33 33 USE obcvol ! " " 34 34 USE lib_mpp ! ??? … … 362 362 END DO 363 363 364 IF(l_ctl) THEN ! print sum trends (used for debugging) 365 WRITE(numout,*) ' spg - Ua: ', SUM( ua(2:jpim1,2:jpjm1,1:jpkm1)*umask(2:jpim1,2:jpjm1,1:jpkm1) ), & 366 & ' Va: ', SUM( va(2:jpim1,2:jpjm1,1:jpkm1)*vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 367 ENDIF 368 364 369 ! 8. Sea surface elevation time stepping 365 370 ! -------------------------------------- -
trunk/NEMO/OPA_SRC/DYN/dynzad.F90
r3 r84 126 126 ! ! =============== 127 127 128 IF( l_ctl .AND. lwp) THEN ! print sum trends (used for debugging)128 IF(l_ctl) THEN ! print sum trends (used for debugging) 129 129 zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 130 130 zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) … … 227 227 END DO 228 228 229 IF( l_ctl .AND. lwp) THEN ! print sum trends (used for debugging)229 IF(l_ctl) THEN ! print sum trends (used for debugging) 230 230 zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 231 231 zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) -
trunk/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r3 r84 342 342 END DO 343 343 344 IF( l_ctl .AND. lwp) THEN ! print sum trends (used for debugging)344 IF(l_ctl) THEN ! print sum trends (used for debugging) 345 345 zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 346 346 zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) -
trunk/NEMO/OPA_SRC/DYN/dynzdf_imp_atsk.F90
r3 r84 312 312 END DO ! End of slab 313 313 ! ! =============== 314 315 IF(l_ctl) THEN ! print sum trends (used for debugging) 316 zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 317 zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 318 WRITE(numout,*) ' zdf - Ua: ', zua-u_ctl, ' Va: ', zva-v_ctl 319 u_ctl = zua ; v_ctl = zva 320 ENDIF 321 314 322 END SUBROUTINE dyn_zdf_imp_tsk 315 323 -
trunk/NEMO/OPA_SRC/FLO/floblk.F90
r16 r84 348 348 # if defined key_obc 349 349 DO jfl = 1, jpnfl 350 IF( lp eastobc) THEN350 IF( lp_obc_east ) THEN 351 351 IF( jped <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpef .AND. nieob-1 <= zgifl(jfl) ) THEN 352 352 zgifl (jfl) = INT(zgifl(jfl)) + 0.5 … … 355 355 END IF 356 356 END IF 357 IF( lp westobc) THEN357 IF( lp_obc_west ) THEN 358 358 IF( jpwd <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpwf .AND. niwob >= zgifl(jfl) ) THEN 359 359 zgifl (jfl) = INT(zgifl(jfl)) + 0.5 … … 362 362 END IF 363 363 END IF 364 IF( lp northobc) THEN364 IF( lp_obc_north ) THEN 365 365 IF( jpnd <= zgifl(jfl) .AND. zgifl(jfl) <= jpnf .AND. njnob-1 >= zgjfl(jfl) ) THEN 366 366 zgifl (jfl) = INT(zgifl(jfl)) + 0.5 … … 369 369 END IF 370 370 END IF 371 IF( lp southobc) THEN371 IF( lp_obc_south ) THEN 372 372 IF( jpsd <= zgifl(jfl) .AND. zgifl(jfl) <= jpsf .AND. njsob >= zgjfl(jfl) ) THEN 373 373 zgifl (jfl) = INT(zgifl(jfl)) + 0.5 … … 408 408 ENDIF 409 409 410 RETURN411 410 END SUBROUTINE flo_blk 412 411 -
trunk/NEMO/OPA_SRC/SBC/bulk.F90
r17 r84 95 95 96 96 # if ! defined key_ice_lim 97 IF( l_ctl .AND. lwp) THEN ! print mean trends (used for debugging)97 IF(l_ctl) THEN ! print mean trends (used for debugging) 98 98 WRITE(numout,*) ' Forcings ' 99 99 WRITE(numout,*) ' qsr_oce : ', SUM( qsr_oce (:,:) * tmask(:,:,1) ) -
trunk/NEMO/OPA_SRC/SBC/flxblk.F90
r18 r84 33 33 34 34 !! * Module variables 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 zeps = 1e-20, &58 zeps0 = 1e-13, &59 zeps1 = 1e-06, &60 zzero = 0.0, &61 62 63 64 65 66 c2 = 0.1, &67 68 69 70 71 72 73 zmue = 0.4! cosine of local solar altitude74 75 76 77 78 79 80 81 82 83 84 85 35 INTEGER, PARAMETER :: & 36 jpintsr = 24 ! number of time step between sunrise and sunset 37 ! ! uses for heat flux computation 38 LOGICAL :: & 39 lbulk_init = .TRUE. ! flag, bulk initialization done or not) 40 41 REAL(wp), DIMENSION(jpi,jpj) :: & 42 stauc , & ! cloud optical depth 43 sbudyko 44 45 !! * constants for bulk computation (flx_blk) 46 REAL(wp), DIMENSION(19) :: & 47 budyko ! BUDYKO's coefficient 48 ! BUDYKO's coefficient (cloudiness effect on LW radiation): 49 DATA budyko / 1.00, 0.98, 0.95, 0.92, 0.89, 0.86, 0.83, 0.80, 0.78, 0.75, & 50 & 0.72, 0.69, 0.67, 0.64, 0.61, 0.58, 0.56, 0.53, 0.50 / 51 REAL(wp), DIMENSION(20) :: & 52 tauco ! cloud optical depth coefficient 53 ! Cloud optical depth coefficient 54 DATA tauco / 6.6, 6.6, 7.0, 7.2, 7.1, 6.8, 6.5, 6.6, 7.1, 7.6, & 55 & 6.6, 6.1, 5.6, 5.5, 5.8, 5.8, 5.6, 5.6, 5.6, 5.6 / 56 REAL(wp) :: & ! constant values 57 zeps = 1.e-20 , & 58 zeps0 = 1.e-13 , & 59 zeps1 = 1.e-06 , & 60 zzero = 0.e0 , & 61 zone = 1.0 62 63 !! * constants for albedo computation (flx_blk_albedo) 64 REAL(wp) :: & 65 c1 = 0.05 , & ! constants values 66 c2 = 0.10 , & 67 albice = 0.50 , & ! albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers) 68 cgren = 0.06 , & ! correction of the snow or ice albedo to take into account 69 ! effects of cloudiness (Grenfell & Perovich, 1984) 70 alphd = 0.80 , & ! coefficients for linear interpolation used to compute 71 alphdi = 0.72 , & ! albedo between two extremes values (Pyane, 1972) 72 alphc = 0.65 , & 73 zmue = 0.40 ! cosine of local solar altitude 74 75 !! * constants for solar declinaison computation (flx_blk_declin) 76 REAL(wp) :: & 77 a0 = 0.39507671 , & ! coefficients 78 a1 = 22.85684301 , & 79 a2 = -0.38637317 , & 80 a3 = 0.15096535 , & 81 a4 = -0.00961411 , & 82 b1 = -4.29692073 , & 83 b2 = 0.05702074 , & 84 b3 = -0.09028607 , & 85 b4 = 0.00592797 86 86 !!---------------------------------------------------------------------- 87 87 !! OPA 9.0 , LODYC-IPSL (2003) … … 237 237 DO jj = 1, jpj 238 238 DO ji = 1 , jpi 239 zalat = ( 90.0 - ABS( gphit(ji,jj) ) ) / 5.0240 zclat = ( 95.0 - gphit(ji,jj) ) / 10.0241 indxb = 1 + INT( zalat )242 ! correction factor to account for the effect of clouds243 sbudyko(ji,jj) = budyko(indxb)244 indxc = 1 + INT( zclat )245 zdl = zclat - INT( zclat )246 zdr = 1.0 - zdl247 stauc(ji,jj) = zdr * tauco( indxc ) + zdl * tauco( indxc + 1 )239 zalat = ( 90.e0 - ABS( gphit(ji,jj) ) ) / 5.e0 240 zclat = ( 95.e0 - gphit(ji,jj) ) / 10.e0 241 indxb = 1 + INT( zalat ) 242 ! correction factor to account for the effect of clouds 243 sbudyko(ji,jj) = budyko(indxb) 244 indxc = 1 + INT( zclat ) 245 zdl = zclat - INT( zclat ) 246 zdr = 1.0 - zdl 247 stauc(ji,jj) = zdr * tauco( indxc ) + zdl * tauco( indxc + 1 ) 248 248 END DO 249 249 END DO 250 250 IF( nleapy == 1 ) THEN 251 yearday = 366. 0251 yearday = 366.e0 252 252 ELSE IF( nleapy == 0 ) THEN 253 yearday = 365. 0253 yearday = 365.e0 254 254 ELSEIF( nleapy == 30) THEN 255 yearday = 360. 0255 yearday = 360.e0 256 256 ENDIF 257 257 lbulk_init = .FALSE. … … 265 265 zqsb_ice(:,:) = 0.e0 266 266 267 zpis2 = rpi / 2. ! pi / 2268 z2pi = 2. * rpi ! 2 * pi267 zpis2 = rpi / 2. 268 z2pi = 2. * rpi 269 269 270 270 !CDIR NOVERRCHK 271 DO jj = 1, jpj271 DO jj = 1, jpj 272 272 !CDIR NOVERRCHK 273 DO ji = 1, jpi274 275 ztatm (ji,jj) = 273.15 + tatm (ji,jj) ! air temperature in Kelvins276 zcatm1(ji,jj) = 1.0 - catm (ji,jj) ! fractional cloud cover277 zfrld (ji,jj) = 1.0 - freeze(ji,jj) ! fractional sea ice cover278 zpatm(ji,jj) = 101000. ! pressure279 280 ! Computation of air density, obtained from the equation of state for dry air.281 zrhoa(ji,jj) = zpatm(ji,jj) / ( 287.04 * ztatm(ji,jj) )282 283 ! zes : Saturation water vapour273 DO ji = 1, jpi 274 275 ztatm (ji,jj) = 273.15 + tatm (ji,jj) ! air temperature in Kelvins 276 zcatm1(ji,jj) = 1.0 - catm (ji,jj) ! fractional cloud cover 277 zfrld (ji,jj) = 1.0 - freeze(ji,jj) ! fractional sea ice cover 278 zpatm(ji,jj) = 101000. ! pressure 279 280 ! Computation of air density, obtained from the equation of state for dry air. 281 zrhoa(ji,jj) = zpatm(ji,jj) / ( 287.04 * ztatm(ji,jj) ) 282 283 ! zes : Saturation water vapour 284 284 ztamr = ztatm(ji,jj) - rtt 285 285 zmt1 = SIGN( 17.269, ztamr ) … … 289 289 & / ( ztatm(ji,jj) - 35.86 + MAX( zzero, zmt3 ) ) ) 290 290 291 ! zev : vapour pressure (hatm is relative humidity)292 zev(ji,jj) = hatm(ji,jj) * zes(ji,jj)293 ! square-root of vapour pressure291 ! zev : vapour pressure (hatm is relative humidity) 292 zev(ji,jj) = hatm(ji,jj) * zes(ji,jj) 293 ! square-root of vapour pressure 294 294 !CDIR NOVERRCHK 295 zevsqr(ji,jj) = SQRT( zev(ji,jj) * 0.01 )296 ! zqapb : specific humidity297 zqatm(ji,jj) = 0.622 * zev(ji,jj) / ( zpatm(ji,jj) - 0.378 * zev(ji,jj) )298 299 300 !----------------------------------------------------301 ! Computation of snow precipitation (Ledley, 1985) |302 !----------------------------------------------------295 zevsqr(ji,jj) = SQRT( zev(ji,jj) * 0.01 ) 296 ! zqapb : specific humidity 297 zqatm(ji,jj) = 0.622 * zev(ji,jj) / ( zpatm(ji,jj) - 0.378 * zev(ji,jj) ) 298 299 300 !---------------------------------------------------- 301 ! Computation of snow precipitation (Ledley, 1985) | 302 !---------------------------------------------------- 303 303 304 304 zmt1 = 253.0 - ztatm(ji,jj) … … 333 333 334 334 iday = INT( zxday ) 335 IF( l_ctl .AND. lwp )WRITE(numout,*) ' declin : iday ', iday, ' nfbulk= ', nfbulk335 IF(l_ctl) WRITE(numout,*) ' declin : iday ', iday, ' nfbulk= ', nfbulk 336 336 ! computation of the solar declination, his sine and his cosine 337 337 CALL flx_blk_declin( indaet, iday, zdecl ) … … 351 351 DO ji = 1, jpi 352 352 ! product of sine of latitude and sine of solar declination 353 zps (ji,jj)= SIN( gphit(ji,jj) * rad ) * zsdecl353 zps (ji,jj) = SIN( gphit(ji,jj) * rad ) * zsdecl 354 354 ! product of cosine of latitude and cosine of solar declination 355 zpc (ji,jj)= COS( gphit(ji,jj) * rad ) * zcdecl355 zpc (ji,jj) = COS( gphit(ji,jj) * rad ) * zcdecl 356 356 ! computation of the both local time of sunrise and sunset 357 zlsrise (ji,jj) =ACOS( - SIGN( zone, zps(ji,jj) ) * MIN( zone, SIGN( zone, zps(ji,jj) ) &357 zlsrise (ji,jj) = ACOS( - SIGN( zone, zps(ji,jj) ) * MIN( zone, SIGN( zone, zps(ji,jj) ) & 358 358 & * ( zps(ji,jj) / zpc(ji,jj) ) ) ) 359 zlsset (ji,jj)= - zlsrise(ji,jj)359 zlsset (ji,jj) = - zlsrise(ji,jj) 360 360 ! dividing the solar day into jpintsr segments of length zdlha 361 zdlha (ji,jj) =( zlsrise(ji,jj) - zlsset(ji,jj) ) / REAL( jpintsr )361 zdlha (ji,jj) = ( zlsrise(ji,jj) - zlsset(ji,jj) ) / REAL( jpintsr ) 362 362 ! computation of the local noon solar altitude 363 zlmunoon(ji,jj) =ASIN ( ( zps(ji,jj) + zpc(ji,jj) ) ) / rad363 zlmunoon(ji,jj) = ASIN ( ( zps(ji,jj) + zpc(ji,jj) ) ) / rad 364 364 365 365 ! cloud correction taken from Reed (1977) (imposed lower than 1) 366 zcldcor (ji,jj) = MIN( zone, ( 1- 0.62 * catm(ji,jj) + 0.0019 * zlmunoon(ji,jj) ) )366 zcldcor (ji,jj) = MIN( zone, ( 1.e0 - 0.62 * catm(ji,jj) + 0.0019 * zlmunoon(ji,jj) ) ) 367 367 END DO 368 368 END DO … … 380 380 DO ji = 1, jpi 381 381 ! local hour angle 382 zlha (ji,jj,jt) = COS ( zlsrise(ji,jj) - zcoef * zdlha(ji,jj) )382 zlha (ji,jj,jt) = COS ( zlsrise(ji,jj) - zcoef * zdlha(ji,jj) ) 383 383 384 384 ! cosine of local solar altitude … … 417 417 !-------------------------------------------------------------------- 418 418 419 zalbocsd(:,:) = 0. 420 zqsro (:,:) = 0. 421 zqsrics (:,:) = 0. 422 zqsrios (:,:) = 0. 419 zalbocsd(:,:) = 0.e0 420 zqsro (:,:) = 0.e0 421 zqsrics (:,:) = 0.e0 422 zqsrios (:,:) = 0.e0 423 423 424 424 DO jt = 1, jpintsr 425 425 # if defined key_vectopt_loop && ! defined key_autotasking 426 426 DO ji = 1, jpij 427 zalbocsd(ji,1) = zalbocsd(ji,1) + zdlha(ji,1) * zalbocs(ji,1,jt) &428 & / MAX( 2.0 * zlsrise(ji,1) , zeps0 )429 zqsro (ji,1) = zqsro(ji,1) + zsqsro (ji,1,jt)430 zqsrics (ji,1) = zqsrics(ji,1) + zsqsrics(ji,1,jt)431 zqsrios (ji,1) = zqsrios(ji,1) + zsqsrios(ji,1,jt)427 zalbocsd(ji,1) = zalbocsd(ji,1) + zdlha (ji,1) * zalbocs(ji,1,jt) & 428 & / MAX( 2.0 * zlsrise(ji,1) , zeps0 ) 429 zqsro (ji,1) = zqsro (ji,1) + zsqsro (ji,1,jt) 430 zqsrics (ji,1) = zqsrics (ji,1) + zsqsrics(ji,1,jt) 431 zqsrios (ji,1) = zqsrios (ji,1) + zsqsrios(ji,1,jt) 432 432 END DO 433 433 # else 434 434 DO jj = 1, jpj 435 435 DO ji = 1, jpi 436 zalbocsd(ji,jj) 437 & / MAX( 2.0 * zlsrise(ji,jj) , zeps0 )438 zqsro (ji,jj) = zqsro(ji,jj) + zsqsro (ji,jj,jt)439 zqsrics(ji,jj) = zqsrics(ji,jj) + zsqsrics(ji,jj,jt)440 zqsrios(ji,jj) = zqsrios(ji,jj) + zsqsrios(ji,jj,jt)436 zalbocsd(ji,jj) = zalbocsd(ji,jj) + zdlha(ji,jj) * zalbocs(ji,jj,jt) & 437 & / MAX( 2.0 * zlsrise(ji,jj) , zeps0 ) 438 zqsro (ji,jj) = zqsro (ji,jj) + zsqsro (ji,jj,jt) 439 zqsrics(ji,jj) = zqsrics (ji,jj) + zsqsrics(ji,jj,jt) 440 zqsrios(ji,jj) = zqsrios (ji,jj) + zsqsrios(ji,jj,jt) 441 441 END DO 442 442 END DO … … 447 447 DO ji = 1, jpi 448 448 449 !-------------------------------------------450 ! Computation of shortwave radiation.451 !-------------------------------------------449 !------------------------------------------- 450 ! Computation of shortwave radiation. 451 !------------------------------------------- 452 452 453 453 ! the solar heat flux absorbed at ocean and snow/ice surfaces … … 478 478 fr2_i0(ji,jj) = 0.82 * zcatm1(ji,jj) + 0.65 * catm(ji,jj) 479 479 480 !---------------------------------------------------------------------------481 ! Computation of long-wave radiation ( Berliand 1952 ; all latitudes )482 !---------------------------------------------------------------------------480 !--------------------------------------------------------------------------- 481 ! Computation of long-wave radiation ( Berliand 1952 ; all latitudes ) 482 !--------------------------------------------------------------------------- 483 483 484 484 ! tempory variables … … 633 633 ! latent heat flux 634 634 zqla_ice(ji,jj) = zrhovacshi * ( zqsati - zqatm(ji,jj) ) 635 qla_ice(ji,jj) = zqla_ice(ji,jj)635 qla_ice (ji,jj) = zqla_ice(ji,jj) 636 636 637 637 ! Computation of sensitivity of non solar fluxes (dQ/dT) … … 750 750 !-------------------------- 751 751 752 llmask = (hsnif == 0. 0) .AND. ( sist >= rt0_ice )752 llmask = (hsnif == 0.e0) .AND. ( sist >= rt0_ice ) 753 753 WHERE ( llmask ) ! ice free of snow and melts 754 754 zalbfz = albice -
trunk/NEMO/OPA_SRC/SBC/flxfwb.F90
r18 r84 130 130 IF( lk_mpp ) CALL mpp_sum( a_rnf ) ! sum over the global domain 131 131 132 IF( aminus /= 0. 0 ) a_aminus = a_aminus + ( MIN( aplus, aminus ) / aminus )133 IF( aplus /= 0. 0 ) a_aplus = a_aplus + ( MIN( aplus, aminus ) / aplus )132 IF( aminus /= 0.e0 ) a_aminus = a_aminus + ( MIN( aplus, aminus ) / aminus ) 133 IF( aplus /= 0.e0 ) a_aplus = a_aplus + ( MIN( aplus, aminus ) / aplus ) 134 134 135 135 -
trunk/NEMO/OPA_SRC/SBC/ocesbc.F90
r19 r84 6 6 7 7 !!---------------------------------------------------------------------- 8 !! oce_sbc : initialization and namelist read 8 !! oce_sbc : ??? 9 !! oce_sbc_dmp : ??? 9 10 !!---------------------------------------------------------------------- 10 11 !! * Modules used … … 34 35 35 36 !! * Shared module variables 36 REAL(wp), PUBLIC :: & 37 REAL(wp), PUBLIC :: & !: 37 38 aplus, aminus, & !: 38 39 empold = 0.e0 !: current year freshwater budget correction 39 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & 40 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 40 41 qt , & !: total surface heat flux (w/m2) 41 42 q , & !: surface heat flux (w/m2) … … 158 159 159 160 ! Re-initialization of fluxes 160 sst_io(:,:) = 0. 0161 sss_io(:,:) = 0. 0162 u_io (:,:) = 0. 0163 v_io (:,:) = 0. 0164 gtaux (:,:) = 0. 165 gtauy (:,:) = 0. 161 sst_io(:,:) = 0.e0 162 sss_io(:,:) = 0.e0 163 u_io (:,:) = 0.e0 164 v_io (:,:) = 0.e0 165 gtaux (:,:) = 0.e0 166 gtauy (:,:) = 0.e0 166 167 167 168 ENDIF … … 257 258 258 259 ! Re-initialization of fluxes 259 sst_io(:,:) = 0. 0260 sss_io(:,:) = 0. 0261 u_io (:,:) = 0. 0262 v_io (:,:) = 0. 0260 sst_io(:,:) = 0.e0 261 sss_io(:,:) = 0.e0 262 u_io (:,:) = 0.e0 263 v_io (:,:) = 0.e0 263 264 264 265 ENDIF … … 651 652 DO jj = 1, jpj 652 653 DO ji = 1, jpi 653 freezn(ji,jj) = MAX(0., SIGN(1., freeze(ji,jj)-rsmall) )654 freezn(ji,jj) = MAX(0., SIGN(1., freeze(ji,jj)-rsmall) ) 654 655 END DO 655 656 END DO … … 683 684 END DO 684 685 ! volume flux associated to internal damping to climatology 685 dmp(:,:) = zstrdmp(:,:) * rauw / ( zsss(:,:) + rsmall ) 686 !!ibu dmp(:,:) = zstrdmp(:,:) * rauw / ( zsss(:,:) + rsmall ) 687 dmp(:,:) = zstrdmp(:,:) * rauw / ( zsss(:,:) + 1.e-20 ) 686 688 # else 687 689 dmp(:,:) = 0.e0 ! No internal damping … … 698 700 zerp = ( 1. - 2.*upsrnfh(ji,jj) ) * zsrp & 699 701 & * ( zsss(ji,jj) - s_dta(ji,jj,1) ) & 700 & / ( zsss(ji,jj) + rsmall ) 702 & / ( zsss(ji,jj) + 1.e-20 ) 703 !ib & / ( zsss(ji,jj) + rsmall ) 701 704 702 705 zerp = MIN( zerp, zplus ) … … 719 722 IF( lk_mpp ) CALL mpp_sum( aplus ) ! sums over the global domain 720 723 IF( lk_mpp ) CALL mpp_sum( aminus ) 721 IF( l_ctl .AND. lwp )WRITE(numout,*) ' oce_sbc_dmp : a+ = ', aplus, ' a- = ', aminus724 IF(l_ctl) WRITE(numout,*) ' oce_sbc_dmp : a+ = ', aplus, ' a- = ', aminus 722 725 723 726 zadefi = MIN( aplus, aminus ) 724 IF( zadefi == 0. 0 ) THEN727 IF( zadefi == 0.e0 ) THEN 725 728 erp(:,:) = 0.e0 726 729 ELSE … … 732 735 erp(:,:) = ( 1. - zfreeze(:,:) ) * zsrp & ! surface restoring term 733 736 & * ( zsss(:,:) - s_dta(:,:,1) ) & 734 & / ( zsss(:,:) + rsmall ) 737 & / ( zsss(:,:) + 1.e-20 ) 738 !ib & / ( zsss(:,:) + rsmall ) 735 739 #endif 736 740
Note: See TracChangeset
for help on using the changeset viewer.