- Timestamp:
- 2014-04-06T17:28:25+02:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r4333 r4616 88 88 # include "vectopt_loop_substitute.h90" 89 89 !!---------------------------------------------------------------------- 90 !! NEMO/OPA 3. 3 , NEMO-consortium (2010)90 !! NEMO/OPA 3.7 , NEMO-consortium (2014) 91 91 !! $Id$ 92 92 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 125 125 !!---------------------------------------------------------------------- 126 126 INTEGER, INTENT(in) :: kt ! ocean time step 127 ! !127 ! 128 128 INTEGER :: ierror ! return error code 129 129 INTEGER :: ifpr ! dummy loop indice … … 141 141 & sn_tdif, rn_zqt , ln_bulk2z, rn_zu 142 142 !!--------------------------------------------------------------------- 143 143 ! 144 144 ! ! ====================== ! 145 145 IF( kt == nit000 ) THEN ! First call kt=nit000 ! … … 149 149 READ ( numnam_ref, namsbc_core, IOSTAT = ios, ERR = 901) 150 150 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_core in reference namelist', lwp ) 151 151 ! 152 152 REWIND( numnam_cfg ) ! Namelist namsbc_core in configuration namelist : CORE bulk parameters 153 153 READ ( numnam_cfg, namsbc_core, IOSTAT = ios, ERR = 902 ) … … 269 269 zwnd_j(:,:) = 0.e0 270 270 #if defined key_cyclone 271 # if defined key_vectopt_loop272 !CDIR COLLAPSE273 # endif274 271 CALL wnd_cyc( kt, zwnd_i, zwnd_j ) ! add Manu ! 275 272 DO jj = 2, jpjm1 … … 279 276 END DO 280 277 END DO 281 #endif282 #if defined key_vectopt_loop283 !CDIR COLLAPSE284 278 #endif 285 279 DO jj = 2, jpjm1 … … 292 286 CALL lbc_lnk( zwnd_j(:,:) , 'T', -1. ) 293 287 ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 294 !CDIR NOVERRCHK295 !CDIR COLLAPSE296 288 wndm(:,:) = SQRT( zwnd_i(:,:) * zwnd_i(:,:) & 297 289 & + zwnd_j(:,:) * zwnd_j(:,:) ) * tmask(:,:,1) … … 306 298 ELSE ; qsr(:,:) = zztmp * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1) 307 299 ENDIF 308 !CDIR COLLAPSE309 300 zqlw(:,:) = ( sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave 310 301 ! ----------------------------------------------------------------------------- ! … … 313 304 314 305 ! ... specific humidity at SST and IST 315 !CDIR NOVERRCHK316 !CDIR COLLAPSE317 306 zqsatw(:,:) = zcoef_qsatw * EXP( -5107.4 / zst(:,:) ) 318 307 … … 340 329 ELSE 341 330 !! If air temp. and spec. hum. are given at same height than wind (10m) : 342 !gm bug? at the compiling phase, add a copy in temporary arrays... ==> check perf343 ! CALL TURB_CORE_1Z( 10., zst (:,:), sf(jp_tair)%fnow(:,:), &344 ! & zqsatw(:,:), sf(jp_humi)%fnow(:,:), wndm(:,:), &345 ! & Cd (:,:), Ch (:,:), Ce (:,:) )346 !gm bug347 ! ARPDBG - this won't compile with gfortran. Fix but check performance348 ! as per comment above.349 331 CALL TURB_CORE_1Z( 10., zst , sf(jp_tair)%fnow(:,:,1), & 350 332 & zqsatw, sf(jp_humi)%fnow(:,:,1), wndm, & 351 & Cd , Ch , Ce )333 & Cd , Ch , Ce ) 352 334 ENDIF 353 335 … … 364 346 ! ... add the HF tau contribution to the wind stress module? 365 347 IF( lhftau ) THEN 366 !CDIR COLLAPSE367 348 taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 368 349 ENDIF … … 387 368 zqsb (:,:) = rhoa*cpa*Ch(:,:)*( zst (:,:) - zt_zu(:,:) ) * wndm(:,:) ! Sensible Heat 388 369 ELSE 389 !CDIR COLLAPSE390 370 zevap(:,:) = rn_efac * MAX( 0.e0, rhoa *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) ) ! Evaporation 391 !CDIR COLLAPSE392 371 zqsb (:,:) = rhoa*cpa*Ch(:,:)*( zst (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:) ! Sensible Heat 393 372 ENDIF 394 !CDIR COLLAPSE395 373 zqla (:,:) = Lv * zevap(:,:) ! Latent Heat 396 374 … … 409 387 ! III Total FLUXES ! 410 388 ! ----------------------------------------------------------------------------- ! 411 412 !CDIR COLLAPSE 389 ! 413 390 emp (:,:) = ( zevap(:,:) & ! mass flux (evap. - precip.) 414 391 & - sf(jp_prec)%fnow(:,:,1) * rn_pfac ) * tmask(:,:,1) 415 !CDIR COLLAPSE416 392 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar flux 417 393 & - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus & ! remove latent melting heat for solid precip … … 579 555 CASE( 'I' ) ! B-grid ice dynamics : I-point (i.e. F-point with sea-ice indexation) 580 556 ! and scalar wind at T-point ( = | U10m - U_ice | ) (masked) 581 !CDIR NOVERRCHK582 557 DO jj = 2, jpjm1 583 558 DO ji = 2, jpim1 ! B grid : NO vector opt … … 604 579 ! 605 580 CASE( 'C' ) ! C-grid ice dynamics : U & V-points (same as ocean) 606 #if defined key_vectopt_loop607 !CDIR COLLAPSE608 #endif609 581 DO jj = 2, jpj 610 582 DO ji = fs_2, jpi ! vect. opt. … … 614 586 END DO 615 587 END DO 616 #if defined key_vectopt_loop617 !CDIR COLLAPSE618 #endif619 588 DO jj = 2, jpjm1 620 589 DO ji = fs_2, fs_jpim1 ! vect. opt. … … 635 604 DO jl = 1, ijpl ! Loop over ice categories ! 636 605 ! ! ========================== ! 637 !CDIR NOVERRCHK638 !CDIR COLLAPSE639 606 DO jj = 1 , jpj 640 !CDIR NOVERRCHK641 607 DO ji = 1, jpi 642 608 ! ----------------------------! … … 690 656 ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 691 657 692 !CDIR COLLAPSE693 658 p_fr1(:,:) = ( 0.18 * ( 1.0 - zcoef_frca ) + 0.35 * zcoef_frca ) 694 !CDIR COLLAPSE695 659 p_fr2(:,:) = ( 0.82 * ( 1.0 - zcoef_frca ) + 0.65 * zcoef_frca ) 696 660 697 !CDIR COLLAPSE698 661 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac ! total precipitation [kg/m2/s] 699 !CDIR COLLAPSE700 662 p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac ! solid precipitation [kg/m2/s] 701 663 CALL iom_put( 'snowpre', p_spr * 86400. ) ! Snow precipitation
Note: See TracChangeset
for help on using the changeset viewer.
