Changeset 12063 for NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC
- Timestamp:
- 2019-12-05T11:46:38+01:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC
- Files:
-
- 14 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/cpl_oasis3.F90
r10582 r12063 114 114 !------------------------------------------------------------------ 115 115 CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror ) 116 IF 116 IF( nerror /= OASIS_Ok ) & 117 117 CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') 118 118 … … 122 122 123 123 CALL oasis_get_localcomm ( kl_comm, nerror ) 124 IF 124 IF( nerror /= OASIS_Ok ) & 125 125 CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 126 126 ! … … 149 149 150 150 ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 151 IF 151 IF( ltmp_wapatch ) THEN 152 152 nldi_save = nldi ; nlei_save = nlei 153 153 nldj_save = nldj ; nlej_save = nlej … … 217 217 ! 218 218 DO ji = 1, ksnd 219 IF 219 IF( ssnd(ji)%laction ) THEN 220 220 221 221 IF( ssnd(ji)%nct > nmaxcat ) THEN … … 228 228 DO jm = 1, kcplmodel 229 229 230 IF 230 IF( ssnd(ji)%nct .GT. 1 ) THEN 231 231 WRITE(cli2,'(i2.2)') jc 232 232 zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2 … … 234 234 zclname = ssnd(ji)%clname 235 235 ENDIF 236 IF 236 IF( kcplmodel > 1 ) THEN 237 237 WRITE(cli2,'(i2.2)') jm 238 238 zclname = 'model'//cli2//'_'//TRIM(zclname) … … 241 241 IF( agrif_fixed() /= 0 ) THEN 242 242 zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 243 END 243 ENDIF 244 244 #endif 245 245 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out 246 246 CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part , (/ 2, 1 /), & 247 247 & OASIS_Out , ishape , OASIS_REAL, nerror ) 248 IF 248 IF( nerror /= OASIS_Ok ) THEN 249 249 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 250 250 CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) … … 262 262 ! 263 263 DO ji = 1, krcv 264 IF 264 IF( srcv(ji)%laction ) THEN 265 265 266 266 IF( srcv(ji)%nct > nmaxcat ) THEN … … 273 273 DO jm = 1, kcplmodel 274 274 275 IF 275 IF( srcv(ji)%nct .GT. 1 ) THEN 276 276 WRITE(cli2,'(i2.2)') jc 277 277 zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2 … … 279 279 zclname = srcv(ji)%clname 280 280 ENDIF 281 IF 281 IF( kcplmodel > 1 ) THEN 282 282 WRITE(cli2,'(i2.2)') jm 283 283 zclname = 'model'//cli2//'_'//TRIM(zclname) … … 286 286 IF( agrif_fixed() /= 0 ) THEN 287 287 zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 288 END 288 ENDIF 289 289 #endif 290 290 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 291 291 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 1 /), & 292 292 & OASIS_In , ishape , OASIS_REAL, nerror ) 293 IF 293 IF( nerror /= OASIS_Ok ) THEN 294 294 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 295 295 CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) … … 310 310 IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 311 311 ! 312 IF 312 IF( ltmp_wapatch ) THEN 313 313 nldi = nldi_save ; nlei = nlei_save 314 314 nldj = nldj_save ; nlej = nlej_save … … 332 332 !!-------------------------------------------------------------------- 333 333 ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 334 IF 334 IF( ltmp_wapatch ) THEN 335 335 nldi_save = nldi ; nlei_save = nlei 336 336 nldj_save = nldj ; nlej_save = nlej … … 349 349 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 350 350 351 IF 352 IF 351 IF( ln_ctl ) THEN 352 IF( kinfo == OASIS_Sent .OR. kinfo == OASIS_ToRest .OR. & 353 353 & kinfo == OASIS_SentOut .OR. kinfo == OASIS_ToRestOut ) THEN 354 354 WRITE(numout,*) '****************' … … 368 368 ENDDO 369 369 ENDDO 370 IF 370 IF( ltmp_wapatch ) THEN 371 371 nldi = nldi_save ; nlei = nlei_save 372 372 nldj = nldj_save ; nlej = nlej_save … … 393 393 !!-------------------------------------------------------------------- 394 394 ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 395 IF 395 IF( ltmp_wapatch ) THEN 396 396 nldi_save = nldi ; nlei_save = nlei 397 397 nldj_save = nldj ; nlej_save = nlej … … 403 403 ! 404 404 DO jc = 1, srcv(kid)%nct 405 IF 405 IF( ltmp_wapatch ) THEN 406 406 IF( nimpp == 1 ) nldi = 1 407 407 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi … … 420 420 & kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 421 421 422 IF 422 IF( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 423 423 424 IF 424 IF( llaction ) THEN 425 425 426 426 kinfo = OASIS_Rcv … … 432 432 ENDIF 433 433 434 IF 434 IF( ln_ctl ) THEN 435 435 WRITE(numout,*) '****************' 436 436 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname … … 450 450 ENDDO 451 451 452 IF 452 IF( ltmp_wapatch ) THEN 453 453 nldi = nldi_save ; nlei = nlei_save 454 454 nldj = nldj_save ; nlej = nlej_save … … 483 483 ! 484 484 DO ji = 1, nsnd 485 IF 485 IF(ssnd(ji)%laction ) THEN 486 486 DO jm = 1, ncplmodel 487 487 IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN … … 495 495 ENDDO 496 496 DO ji = 1, nrcv 497 IF 497 IF(srcv(ji)%laction ) THEN 498 498 DO jm = 1, ncplmodel 499 499 IF( srcv(ji)%nid(1,jm) /= -1 ) THEN … … 529 529 ! 530 530 DEALLOCATE( exfld ) 531 IF 531 IF(nstop == 0) THEN 532 532 CALL oasis_terminate( nerror ) 533 533 ELSE -
NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/cyclone.F90
r10068 r12063 137 137 zhemi = SIGN( 1. , zrlat ) 138 138 zinfl = 15.* rad ! clim inflow angle in Tropical Cyclones 139 IF 139 IF( vortex == 0 ) THEN 140 140 141 141 ! Vortex Holland reconstruct wind at each lon-lat position … … 157 157 & + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) ) 158 158 159 IF 159 IF(zdist < zrout2) THEN ! calculation of wind only to a given max radius 160 160 ! shape of the wind profile 161 161 zztmp = ( zrmw / ( zdist + 1.e-12 ) )**zb 162 162 zztmp = zvmax * SQRT( zztmp * EXP(1. - zztmp) ) 163 163 164 IF 164 IF(zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2 165 165 zztmp = zztmp * ( (zrout2-zdist)*1.e-6 ) 166 166 ENDIF 167 167 168 168 ! !!! KILL EQ WINDS 169 ! IF 169 ! IF(SIGN( 1. , zrlat ) /= zhemi) THEN 170 170 ! zztmp = 0. ! winds in other hemisphere 171 ! IF 172 ! ENDIF 173 ! IF 171 ! IF(ABS(gphit(ji,jj)) <= 5.) zztmp=0. ! kill between 5N-5S 172 ! ENDIF 173 ! IF(ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN 174 174 ! zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) ) 175 175 ! !linear to zero between 10 and 5 … … 177 177 ! !!! / KILL EQ 178 178 179 IF 179 IF(ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude 180 180 181 181 zwnd_t = COS( zinfl ) * zztmp … … 196 196 END DO 197 197 198 ELSE IF 198 ELSE IF( vortex == 1 ) THEN 199 199 200 200 ! Vortex Willoughby reconstruct wind at each lon-lat position … … 206 206 zn = 2.1340 + 0.0077*zvmax - 0.4522*LOG(zrmw/1000.) - 0.0038*ABS( ztct(jtc,jp_lat) ) 207 207 zA = 0.5913 + 0.0029*zvmax - 0.1361*LOG(zrmw/1000.) - 0.0042*ABS( ztct(jtc,jp_lat) ) 208 IF 208 IF(zA < 0) THEN 209 209 zA=0 210 210 ENDIF … … 218 218 & + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) ) 219 219 220 IF 220 IF(zdist < zrout2) THEN ! calculation of wind only to a given max radius 221 221 222 222 ! shape of the wind profile 223 IF 223 IF(zdist <= zrmw) THEN ! inside the Radius of Maximum Wind 224 224 zztmp = zvmax * (zdist/zrmw)**zn 225 225 ELSE … … 227 227 ENDIF 228 228 229 IF 229 IF(zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2 230 230 zztmp = zztmp * ( (zrout2-zdist)*1.e-6 ) 231 231 ENDIF 232 232 233 233 ! !!! KILL EQ WINDS 234 ! IF 234 ! IF(SIGN( 1. , zrlat ) /= zhemi) THEN 235 235 ! zztmp = 0. ! winds in other hemisphere 236 ! IF 237 ! ENDIF 238 ! IF 236 ! IF(ABS(gphit(ji,jj)) <= 5.) zztmp=0. ! kill between 5N-5S 237 ! ENDIF 238 ! IF(ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN 239 239 ! zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) ) 240 240 ! !linear to zero between 10 and 5 … … 242 242 ! !!! / KILL EQ 243 243 244 IF 244 IF(ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude 245 245 246 246 zwnd_t = COS( zinfl ) * zztmp -
NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/fldread.F90
r11857 r12063 167 167 IF( PRESENT(kit) ) ll_firstcall = ll_firstcall .and. kit == 1 168 168 169 IF 169 IF( nn_components == jp_iam_sas ) THEN ; it_offset = nn_fsbc 170 170 ELSE ; it_offset = 0 171 171 ENDIF … … 389 389 ENDIF 390 390 ! 391 IF 391 IF( sdjf%cltype(1:4) == 'week' ) THEN 392 392 isec_week = isec_week + ksec_week( sdjf%cltype(6:8) ) ! second since the beginning of the week 393 393 llprevmth = isec_week > nsec_month ! longer time since the beginning of the week than the month … … 464 464 ENDIF 465 465 ! 466 IF 466 IF( nn_components == jp_iam_sas ) THEN ; it_offset = nn_fsbc 467 467 ELSE ; it_offset = 0 468 468 ENDIF … … 656 656 ENDIF 657 657 CASE DEFAULT 658 IF 658 IF(lk_c1d .AND. lmoor ) THEN 659 659 IF( sdjf%ln_tint ) THEN 660 660 CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(2,2,:,2), sdjf%nrec_a(1) ) … … 1071 1071 imonth = kmonth 1072 1072 iday = kday 1073 IF 1073 IF( sdjf%cltype(1:4) == 'week' ) THEN ! find the day of the beginning of the week 1074 1074 isec_week = ksec_week( sdjf%cltype(6:8) )- (86400 * 8 ) 1075 1075 llprevmth = isec_week > nsec_month ! longer time since beginning of the week than the month … … 1080 1080 ENDIF 1081 1081 ELSE ! use current day values 1082 IF 1082 IF( sdjf%cltype(1:4) == 'week' ) THEN ! find the day of the beginning of the week 1083 1083 isec_week = ksec_week( sdjf%cltype(6:8) ) ! second since the beginning of the week 1084 1084 llprevmth = isec_week > nsec_month ! longer time since beginning of the week than the month … … 1319 1319 !! get dimensions 1320 1320 !!GS: we consider 2D data as 3D data with vertical dim size = 1 1321 !IF 1322 IF 1321 !IF( SIZE(sd%fnow, 3) > 1 ) THEN 1322 IF( SIZE(sd%fnow, 3) > 0 ) THEN 1323 1323 ALLOCATE( ddims(4) ) 1324 1324 ELSE … … 1333 1333 1334 1334 CALL iom_open ( sd%wgtname, inum ) ! interpolation weights 1335 IF 1335 IF( inum > 0 ) THEN 1336 1336 1337 1337 !! determine whether we have an east-west cyclic grid … … 1666 1666 END DO 1667 1667 1668 IF 1668 IF(ref_wgts(kw)%numwgt .EQ. 16) THEN 1669 1669 1670 1670 !! fix up halo points that we couldnt read from file … … 1751 1751 END DO 1752 1752 ! 1753 END 1753 ENDIF 1754 1754 ! 1755 1755 END SUBROUTINE fld_interp -
NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbc_oce.F90
r12015 r12063 160 160 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_m !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-] 161 161 162 !!----------------------------------------------------------------------163 !! Cool-skin/Warm-layer164 !!----------------------------------------------------------------------165 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tsk !: sea-surface skin temperature (used if ln_skin_cs==.true. .OR. ln_skin_wl==.true.) [K] !LB166 167 168 162 !! * Substitutions 169 163 # include "vectopt_loop_substitute.h90" -
NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcapr.F90
r11348 r12063 103 103 ! 104 104 ! !* control check 105 IF 105 IF( ln_apr_obc ) THEN 106 106 IF(lwp) WRITE(numout,*) ' Inverse barometer added to OBC ssh data' 107 107 ENDIF -
NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcblk.F90
r12021 r12063 58 58 USE prtctl ! Print control 59 59 60 USE sbcblk_phy ! LB: all thermodynamics functions in the marine boundary layer, rho_air, q_sat, etc...60 USE sbcblk_phy ! a catalog of functions for physical/meteorological parameters in the marine boundary layer, rho_air, q_sat, etc... 61 61 62 62 … … 95 95 LOGICAL :: ln_ECMWF ! "ECMWF" algorithm (IFS cycle 45r1) 96 96 ! 97 LOGICAL :: ln_Cd_L12 ! ice-atm drag = F( ice concentration ) (Lupkes et al. JGR2012) 98 LOGICAL :: ln_Cd_L15 ! ice-atm drag = F( ice concentration, atmospheric stability ) (Lupkes et al. JGR2015) 99 ! 97 100 REAL(wp) :: rn_pfac ! multiplication factor for precipitation 98 101 REAL(wp), PUBLIC :: rn_efac ! multiplication factor for evaporation … … 100 103 REAL(wp) :: rn_zqt ! z(q,t) : height of humidity and temperature measurements 101 104 REAL(wp) :: rn_zu ! z(u) : height of wind measurements 102 !103 LOGICAL :: ln_Cd_L12 ! ice-atm drag = F( ice concentration ) (Lupkes et al. JGR2012)104 LOGICAL :: ln_Cd_L15 ! ice-atm drag = F( ice concentration, atmospheric stability ) (Lupkes et al. JGR2015)105 105 ! 106 106 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: Cd_ice , Ch_ice , Ce_ice ! transfert coefficients over ice … … 140 140 !! *** ROUTINE sbc_blk_alloc *** 141 141 !!------------------------------------------------------------------- 142 ALLOCATE( t_zu(jpi,jpj) , q_zu(jpi,jpj) , tsk(jpi,jpj) ,&142 ALLOCATE( t_zu(jpi,jpj) , q_zu(jpi,jpj) , & 143 143 & Cdn_oce(jpi,jpj), Chn_oce(jpi,jpj), Cen_oce(jpi,jpj), & 144 144 & Cd_ice (jpi,jpj), Ch_ice (jpi,jpj), Ce_ice (jpi,jpj), STAT=sbc_blk_alloc ) … … 212 212 IF( nn_fsbc /= 1 ) & 213 213 & CALL ctl_stop( 'sbc_blk_init: Please set "nn_fsbc" to 1 when using cool-skin/warm-layer param.') 214 END IF 215 216 IF( ln_skin_wl ) THEN 217 !! Check if the frequency of downwelling solar flux input makes sense and if ln_dm2dc=T if it is daily! 218 IF( (sn_qsr%freqh < 0.).OR.(sn_qsr%freqh > 24.) ) & 219 & CALL ctl_stop( 'sbc_blk_init: Warm-layer param. (ln_skin_wl) not compatible with freq. of solar flux > daily' ) 220 IF( (sn_qsr%freqh == 24.).AND.(.NOT. ln_dm2dc) ) & 221 & CALL ctl_stop( 'sbc_blk_init: Please set ln_dm2dc=T for warm-layer param. (ln_skin_wl) to work properly' ) 214 222 END IF 215 223 … … 361 369 !! the wind velocity (j-component) at z=rn_zu (m/s) at T-point 362 370 !! the specific humidity at z=rn_zqt (kg/kg) 363 !! the solar heat at z=rn_zqt (W/m2) 371 !! the air temperature at z=rn_zqt (Kelvin) 372 !! the solar heat (W/m2) 364 373 !! the Long wave (W/m2) 365 !! the air temperature (Kelvin)366 374 !! the total precipitation (rain+snow) (Kg/m2/s) 367 375 !! the snow (solid precipitation) (kg/m2/s) … … 390 398 CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step 391 399 ! 392 IF( kt == nit000 ) tsk(:,:) = sst_m(:,:)*tmask(:,:,1) ! no previous estimate of skin temperature => using bulk SST 393 ! 400 ! ! compute the surface ocean fluxes using bulk formulea 394 401 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 395 402 CALL blk_oce_1( kt, sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1), & ! <<= in … … 557 564 ! (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2 558 565 ! (since reanalysis products provide T at z, not theta !) 559 ztpot = ptair(:,:) + gamma_moist( ptair(:,:), zqair(:,:) ) * rn_zqt 566 !#LB: because AGRIF hates functions that return something else than a scalar, need to 567 ! use scalar version of gamma_moist() ... 568 DO jj = 1, jpj 569 DO ji = 1, jpi 570 ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt 571 END DO 572 END DO 560 573 ENDIF 561 574 … … 598 611 ELSEWHERE 599 612 ! we forget about the update... 600 zst(:,:) = zztmp1(:,:) ! LB: using what we backed up before skin-algo601 pssq(:,:) = zztmp2(:,:) ! LB: " " "613 zst(:,:) = zztmp1(:,:) !#LB: using what we backed up before skin-algo 614 pssq(:,:) = zztmp2(:,:) !#LB: " " " 602 615 END WHERE 603 tsk(:,:) = zst(:,:) !#LB: Update of tsk, the "official" array for skin temperature604 616 END IF 605 617 … … 726 738 ! ----------------------------- 727 739 728 zqla(:,:) = L_vap( zst(:,:) ) * pevp(:,:) * -1._wp ! Latent Heat flux !!GS: possibility to add a global qla to avoid recomputation after abl update 740 ! use scalar version of L_vap() for AGRIF compatibility 741 DO jj = 1, jpj 742 DO ji = 1, jpi 743 zqla(ji,jj) = L_vap( zst(ji,jj) ) * pevp(ji,jj) * -1._wp ! Latent Heat flux !!GS: possibility to add a global qla to avoid recomputation after abl update 744 ENDDO 745 ENDDO 729 746 730 747 IF(ln_ctl) THEN … … 755 772 #endif 756 773 ! 757 CALL iom_put( "rho_air" , rhoa ) ! output air density (kg/m^3) !#LB 758 CALL iom_put( "qlw_oce" , zqlw ) ! output downward longwave heat over the ocean 759 CALL iom_put( "qsb_oce" , psen ) ! output downward sensible heat over the ocean 760 CALL iom_put( "qla_oce" , zqla ) ! output downward latent heat over the ocean 761 CALL iom_put( "evap_oce" , pevp ) ! evaporation 762 CALL iom_put( "qemp_oce" , qns-zqlw-psen-zqla ) ! output downward heat content of E-P over the ocean 763 CALL iom_put( "qns_oce" , qns ) ! output downward non solar heat over the ocean 764 CALL iom_put( "qsr_oce" , qsr ) ! output downward solar heat over the ocean 765 CALL iom_put( "qt_oce" , qns+qsr ) ! output total downward heat over the ocean 766 tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1) ! output total precipitation [kg/m2/s] 767 sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1) ! output solid precipitation [kg/m2/s] 768 CALL iom_put( 'snowpre', sprecip ) ! Snow 769 CALL iom_put( 'precip' , tprecip ) ! Total precipitation 774 CALL iom_put( "rho_air" , rhoa*tmask(:,:,1) ) ! output air density [kg/m^3] 775 CALL iom_put( "evap_oce" , pevp ) ! evaporation 776 CALL iom_put( "qlw_oce" , zqlw ) ! output downward longwave heat over the ocean 777 CALL iom_put( "qsb_oce" , psen ) ! output downward sensible heat over the ocean 778 CALL iom_put( "qla_oce" , zqla ) ! output downward latent heat over the ocean 779 tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1) ! output total precipitation [kg/m2/s] 780 sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1) ! output solid precipitation [kg/m2/s] 781 CALL iom_put( 'snowpre', sprecip ) ! Snow 782 CALL iom_put( 'precip' , tprecip ) ! Total precipitation 783 ! 784 IF ( nn_ice == 0 ) THEN 785 CALL iom_put( "qemp_oce" , qns-zqlw-psen-zqla ) ! output downward heat content of E-P over the ocean 786 CALL iom_put( "qns_oce" , qns ) ! output downward non solar heat over the ocean 787 CALL iom_put( "qsr_oce" , qsr ) ! output downward solar heat over the ocean 788 CALL iom_put( "qt_oce" , qns+qsr ) ! output total downward heat over the ocean 789 ENDIF 790 ! 770 791 IF( ln_skin_cs .OR. ln_skin_wl ) THEN 771 792 CALL iom_put( "t_skin" , (zst - rt0) * tmask(:,:,1) ) ! T_skin in Celsius … … 1295 1316 zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) ) ! Eq. 53 1296 1317 1297 ! Momentum and Heat Stability functions ( !!GS:possibility to use psi_m_ecmwf instead ?)1318 ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead ?) 1298 1319 z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water 1299 1320 z0i = z0_skin_ice ! over ice … … 1325 1346 END DO 1326 1347 END DO 1327 !1328 1348 CALL lbc_lnk_multi( 'sbcblk', pcd, 'T', 1., pch, 'T', 1. ) 1329 1349 ! -
NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcblk_algo_ncar.F90
r12015 r12063 26 26 USE dom_oce ! ocean space and time domain 27 27 USE phycst ! physical constants 28 USE sbc_oce ! Surface boundary condition: ocean fields 29 USE sbcwave, ONLY : cdn_wave ! wave module 30 #if defined key_si3 || defined key_cice 31 USE sbc_ice ! Surface boundary condition: ice fields 32 #endif 33 ! 28 34 USE iom ! I/O manager library 29 35 USE lib_mpp ! distribued memory computing library 30 36 USE in_out_manager ! I/O manager 31 37 USE prtctl ! Print control 32 USE sbcwave, ONLY : cdn_wave ! wave module33 #if defined key_si3 || defined key_cice34 USE sbc_ice ! Surface boundary condition: ice fields35 #endif36 38 USE lib_fortran ! to use key_nosignedzero 37 39 38 USE sbc_oce ! Surface boundary condition: ocean fields39 40 USE sbcblk_phy ! all thermodynamics functions, rho_air, q_sat, etc... !LB 40 41 … … 52 53 & Cd, Ch, Ce, t_zu, q_zu, U_blk, & 53 54 & Cdn, Chn, Cen ) 54 !!---------------------------------------------------------------------- 55 !!---------------------------------------------------------------------------------- 55 56 !! *** ROUTINE turb_ncar *** 56 57 !! -
NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbccpl.F90
r11348 r12063 453 453 CASE( 'conservative' ) 454 454 srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 455 IF 455 IF( k_ice <= 1 ) srcv(jpr_ievp)%laction = .FALSE. 456 456 CASE( 'oce and ice' ) ; srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE. 457 457 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) … … 557 557 srcv(jpr_botm )%clname = 'OBotMlt' 558 558 IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 559 IF 559 IF( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 560 560 srcv(jpr_topm:jpr_botm)%nct = nn_cats_cpl 561 561 ELSE … … 568 568 ! ! ------------------------- ! 569 569 srcv(jpr_ts_ice)%clname = 'OTsfIce' ! needed by Met Office 570 IF 571 IF 572 IF 570 IF( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' ) srcv(jpr_ts_ice)%laction = .TRUE. 571 IF( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' ) srcv(jpr_ts_ice)%nct = nn_cats_cpl 572 IF( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = nn_cats_cpl 573 573 574 574 ! ! ------------------------- ! … … 692 692 ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere 693 693 DO jn = 1, jprcv 694 IF 694 IF( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 695 695 END DO 696 696 ! … … 719 719 ! =================================================== ! 720 720 DO jn = 1, jprcv 721 IF 721 IF( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 722 722 END DO 723 723 ! Allocate taum part of frcv which is used even when not received as coupling field 724 IF 724 IF( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 725 725 ! Allocate w10m part of frcv which is used even when not received as coupling field 726 IF 726 IF( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 727 727 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 728 IF 729 IF 728 IF( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 729 IF( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 730 730 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 731 731 IF( k_ice /= 0 ) THEN 732 IF 733 IF 734 END 732 IF( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 733 IF( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 734 ENDIF 735 735 736 736 ! ================================ ! … … 756 756 CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice' ) 757 757 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 758 IF 758 IF( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = nn_cats_cpl 759 759 CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE. 760 760 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) … … 776 776 ! 1. sending mixed oce-ice albedo or 777 777 ! 2. receiving mixed oce-ice solar radiation 778 IF 778 IF( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 779 779 CALL oce_alb( zaos, zacs ) 780 780 ! Due to lack of information on nebulosity : mean clear/overcast sky … … 795 795 ssnd(jps_fice1)%laction = .TRUE. ! First-order regridded ice concentration, to be used producing atmos-to-ice fluxes (Met Office requirement) 796 796 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 797 IF 798 IF 797 IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = nn_cats_cpl 798 IF( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl 799 799 ENDIF 800 800 801 IF 801 IF(TRIM( sn_snd_ifrac%cldes ) == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 802 802 803 803 SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) … … 805 805 CASE( 'ice and snow' ) 806 806 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 807 IF 807 IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 808 808 ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 809 809 ENDIF 810 810 CASE ( 'weighted ice and snow' ) 811 811 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 812 IF 812 IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 813 813 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 814 814 END SELECT … … 827 827 ssnd(jps_a_p)%laction = .TRUE. 828 828 ssnd(jps_ht_p)%laction = .TRUE. 829 IF 829 IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 830 830 ssnd(jps_a_p)%nct = nn_cats_cpl 831 831 ssnd(jps_ht_p)%nct = nn_cats_cpl 832 832 ELSE 833 IF 833 IF( nn_cats_cpl > 1 ) THEN 834 834 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 835 835 ENDIF … … 838 838 ssnd(jps_a_p)%laction = .TRUE. 839 839 ssnd(jps_ht_p)%laction = .TRUE. 840 IF 840 IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 841 841 ssnd(jps_a_p)%nct = nn_cats_cpl 842 842 ssnd(jps_ht_p)%nct = nn_cats_cpl … … 913 913 CASE ( 'ice only' ) 914 914 ssnd(jps_ttilyr)%laction = .TRUE. 915 IF 915 IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN 916 916 ssnd(jps_ttilyr)%nct = nn_cats_cpl 917 917 ELSE 918 IF 918 IF( nn_cats_cpl > 1 ) THEN 919 919 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' ) 920 920 ENDIF … … 922 922 CASE ( 'weighted ice' ) 923 923 ssnd(jps_ttilyr)%laction = .TRUE. 924 IF 924 IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl 925 925 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes ) 926 926 END SELECT … … 932 932 CASE ( 'ice only' ) 933 933 ssnd(jps_kice)%laction = .TRUE. 934 IF 934 IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 935 935 ssnd(jps_kice)%nct = nn_cats_cpl 936 936 ELSE 937 IF 937 IF( nn_cats_cpl > 1 ) THEN 938 938 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 939 939 ENDIF … … 941 941 CASE ( 'weighted ice' ) 942 942 ssnd(jps_kice)%laction = .TRUE. 943 IF 943 IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl 944 944 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes ) 945 945 END SELECT … … 1002 1002 ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 1003 1003 DO jn = 1, jpsnd 1004 IF 1004 IF( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 1005 1005 END DO 1006 1006 ! … … 1029 1029 CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 1030 1030 1031 IF 1031 IF(ln_usecplmask) THEN 1032 1032 xcplmask(:,:,:) = 0. 1033 1033 CALL iom_open( 'cplmask', inum ) … … 1265 1265 1266 1266 IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) ! correct this later (read from restart if possible) 1267 END 1267 ENDIF 1268 1268 ! 1269 1269 IF( ln_sdw ) THEN ! Stokes Drift correction activated … … 1414 1414 ELSE IF( srcv(jpr_qnsmix)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1415 1415 ELSE ; zqns(:,:) = 0._wp 1416 END 1416 ENDIF 1417 1417 ! update qns over the free ocean with: 1418 1418 IF( nn_components /= jp_iam_opa ) THEN … … 1686 1686 ! --- evaporation over ice (kg/m2/s) --- ! 1687 1687 DO jl=1,jpl 1688 IF 1688 IF(sn_rcv_emp%clcat == 'yes') THEN ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 1689 1689 ELSE ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 ) ; ENDIF 1690 1690 ENDDO … … 1785 1785 CASE( 'conservative' ) ! the required fields are directly provided 1786 1786 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1787 IF 1787 IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1788 1788 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1789 1789 ELSE … … 1794 1794 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1795 1795 zqns_tot(:,:) = ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1796 IF 1796 IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1797 1797 DO jl=1,jpl 1798 1798 zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) … … 1896 1896 #endif 1897 1897 ! outputs 1898 IF 1899 IF 1900 IF 1901 IF 1898 IF( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving 1899 IF( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * rLfus ) ! latent heat from icebergs melting 1900 IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1901 IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 1902 1902 & * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from evap (cell average) 1903 IF 1904 IF 1903 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) ) ! heat flux from snow (cell average) 1904 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1905 1905 & * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean) 1906 IF 1906 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1907 1907 & * zsnw(:,:) ) ! heat flux from snow (over ice) 1908 1908 ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. … … 1915 1915 CASE( 'conservative' ) 1916 1916 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1917 IF 1917 IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1918 1918 zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 1919 1919 ELSE … … 1927 1927 CASE( 'oce and ice' ) 1928 1928 zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1929 IF 1929 IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1930 1930 DO jl = 1, jpl 1931 1931 zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) … … 1983 1983 ! ! ========================= ! 1984 1984 CASE ('coupled') 1985 IF 1985 IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 1986 1986 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 1987 1987 ELSE … … 2061 2061 IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 2062 2062 2063 IF 2063 IF( nn_components == jp_iam_opa ) THEN 2064 2064 ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 2065 2065 ELSE … … 2466 2466 IF( ssnd(jps_ficet)%laction ) THEN 2467 2467 CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info ) 2468 END 2468 ENDIF 2469 2469 ! ! ------------------------- ! 2470 2470 ! ! Water levels to waves ! … … 2481 2481 ENDIF 2482 2482 CALL cpl_snd( jps_wlev , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2483 END 2483 ENDIF 2484 2484 ! 2485 2485 ! Fields sent by OPA to SAS when doing OPA<->SAS coupling -
NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcice_cice.F90
r11348 r12063 132 132 IF ( ksbc == jp_flx ) THEN 133 133 CALL cice_sbc_force(kt) 134 ELSE IF 134 ELSE IF( ksbc == jp_purecpl ) THEN 135 135 CALL sbc_cpl_ice_flx( fr_i ) 136 136 ENDIF … … 140 140 CALL cice_sbc_out ( kt, ksbc ) 141 141 142 IF 142 IF( ksbc == jp_purecpl ) CALL cice_sbc_hadgam(kt+1) 143 143 144 144 ENDIF ! End sea-ice time step only … … 168 168 ! there is no restart file. 169 169 ! Values from a CICE restart file would overwrite this 170 IF 170 IF( .NOT. ln_rstart ) THEN 171 171 CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.) 172 172 ENDIF … … 177 177 178 178 ! Do some CICE consistency checks 179 IF 180 IF 179 IF( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 180 IF( calc_strair .OR. calc_Tsfc ) THEN 181 181 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) 182 182 ENDIF 183 ELSEIF 184 IF 183 ELSEIF(ksbc == jp_blk) THEN 184 IF( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN 185 185 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' ) 186 186 ENDIF … … 202 202 203 203 CALL cice2nemo(aice,fr_i, 'T', 1. ) 204 IF 204 IF( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 205 205 DO jl=1,ncat 206 206 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 297 297 ! forced and coupled case 298 298 299 IF 299 IF( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 300 300 301 301 ztmpn(:,:,:)=0.0 … … 322 322 323 323 ! Surface downward latent heat flux (CI_5) 324 IF 324 IF(ksbc == jp_flx) THEN 325 325 DO jl=1,ncat 326 326 ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) … … 332 332 DO jj=1,jpj 333 333 DO ji=1,jpi 334 IF 334 IF(fr_i(ji,jj).eq.0.0) THEN 335 335 DO jl=1,ncat 336 336 ztmpn(ji,jj,jl)=0.0 … … 351 351 ! GBM conductive flux through ice (CI_6) 352 352 ! Convert to GBM 353 IF 353 IF(ksbc == jp_flx) THEN 354 354 ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 355 355 ELSE … … 360 360 ! GBM surface heat flux (CI_7) 361 361 ! Convert to GBM 362 IF 362 IF(ksbc == jp_flx) THEN 363 363 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 364 364 ELSE … … 368 368 ENDDO 369 369 370 ELSE IF 370 ELSE IF(ksbc == jp_blk) THEN 371 371 372 372 ! Pass bulk forcing fields to CICE (which will calculate heat fluxes etc itself) … … 546 546 ! Freshwater fluxes 547 547 548 IF 548 IF(ksbc == jp_flx) THEN 549 549 ! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip) 550 550 ! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below … … 552 552 ! Better to use evap and tprecip? (but for now don't read in evap in this case) 553 553 emp(:,:) = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 554 ELSE IF 554 ELSE IF(ksbc == jp_blk) THEN 555 555 emp(:,:) = (1.0-fr_i(:,:))*emp(:,:) 556 ELSE IF 556 ELSE IF(ksbc == jp_purecpl) THEN 557 557 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) 558 558 ! This is currently as required with the coupling fields from the UM atmosphere … … 584 584 ! Scale qsr and qns according to ice fraction (bulk formulae only) 585 585 586 IF 586 IF(ksbc == jp_blk) THEN 587 587 qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:)) 588 588 qns(:,:)=qns(:,:)*(1.0-fr_i(:,:)) 589 589 ENDIF 590 590 ! Take into account snow melting except for fully coupled when already in qns_tot 591 IF 591 IF(ksbc == jp_purecpl) THEN 592 592 qsr(:,:)= qsr_tot(:,:) 593 593 qns(:,:)= qns_tot(:,:) … … 624 624 625 625 CALL cice2nemo(aice,fr_i,'T', 1. ) 626 IF 626 IF( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 627 627 DO jl=1,ncat 628 628 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 879 879 ! B. Gather pn into global array (png) 880 880 881 IF 881 IF( jpnij > 1) THEN 882 882 CALL mppsync 883 883 CALL mppgather (pn,0,png) … … 892 892 ! (may be OK but not 100% sure) 893 893 894 IF 894 IF(nproc==0) THEN 895 895 ! pcg(:,:)=0.0 896 896 DO jn=1,jpnij … … 1015 1015 ! the lbclnk call on pn will replace these with sensible values 1016 1016 1017 IF 1017 IF(nproc==0) THEN 1018 1018 png(:,:,:)=0.0 1019 1019 DO jn=1,jpnij … … 1028 1028 ! C. Scatter png into NEMO field (pn) for each processor 1029 1029 1030 IF 1030 IF( jpnij > 1) THEN 1031 1031 CALL mppsync 1032 1032 CALL mppscatter (png,0,pn) -
NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcisf.F90
r11348 r12063 303 303 ! 304 304 ! Allocate public variable 305 IF 305 IF( sbc_isf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_isf : unable to allocate arrays' ) 306 306 ! 307 307 ! initialisation … … 440 440 !! Initialize arrays to 0 (each step) 441 441 zt_sum = 0.e0_wp 442 IF 442 IF( ik > 1 ) THEN 443 443 ! 1. -----------the average temperature between 200m and 600m --------------------- 444 444 DO jk = misfkt(ji,jj),misfkb(ji,jj) … … 459 459 ELSE 460 460 qisf(ji,jj) = 0._wp ; fwfisf(ji,jj) = 0._wp 461 END 461 ENDIF 462 462 END DO 463 463 END DO … … 496 496 ! coeficient for linearisation of potential tfreez 497 497 ! Crude approximation for pressure (but commonly used) 498 IF 498 IF( l_useCT ) THEN ! linearisation from Jourdain et al. (2017) 499 499 zlamb1 =-0.0564_wp 500 500 zlamb2 = 0.0773_wp … … 558 558 ! compute s freeze 559 559 zsfrz=(-zbqe-SQRT(zdis))*zaqer 560 IF 560 IF( zsfrz < 0.0_wp ) zsfrz=(-zbqe+SQRT(zdis))*zaqer 561 561 562 562 ! compute t freeze (eq. 22) … … 578 578 579 579 ! define if we need to iterate (nn_gammablk 0/1 do not need iteration) 580 IF 580 IF( nn_gammablk < 2 ) THEN ; lit = .FALSE. 581 581 ELSE 582 582 ! check total number of iteration 583 IF 583 IF(nit >= 100) THEN ; CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' ) 584 584 ELSE ; nit = nit + 1 585 END 585 ENDIF 586 586 587 587 ! compute error between 2 iterations 588 588 ! if needed save gammat and compute zhtflx_b for next iteration 589 589 zerr = MAXVAL(ABS(zhtflx-zhtflx_b)) 590 IF 590 IF( zerr <= 0.01_wp ) THEN ; lit = .FALSE. 591 591 ELSE ; zhtflx_b(:,:) = zhtflx(:,:) 592 END 593 END 592 ENDIF 593 ENDIF 594 594 END DO 595 595 ! … … 718 718 pgt(ji,jj) = zustar(ji,jj) / (zgturb + zgmolet) 719 719 pgs(ji,jj) = zustar(ji,jj) / (zgturb + zgmoles) 720 END 720 ENDIF 721 721 END DO 722 722 END DO … … 757 757 ! determine the deepest level influenced by the boundary layer 758 758 DO jk = ikt+1, mbku(ji,jj) 759 IF 759 IF( (SUM(e3u_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (umask(ji,jj,jk) == 1) ) ikb = jk 760 760 END DO 761 761 zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3u_n(ji,jj,ikt:ikb))) ! limit the tbl to water thickness. … … 789 789 ! determine the deepest level influenced by the boundary layer 790 790 DO jk = ikt+1, mbkv(ji,jj) 791 IF 791 IF( (SUM(e3v_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (vmask(ji,jj,jk) == 1) ) ikb = jk 792 792 END DO 793 793 zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3v_n(ji,jj,ikt:ikb))) ! limit the tbl to water thickness. … … 869 869 ! determine the deepest level influenced by the boundary layer 870 870 DO jk = ikt, mbkt(ji,jj) 871 IF 871 IF( (SUM(e3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 872 872 END DO 873 873 rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t_n(ji,jj,ikt:ikb))) ! limit the tbl to water thickness. … … 879 879 END DO 880 880 END DO 881 END 881 ENDIF 882 882 ! 883 883 !== ice shelf melting distributed over several levels ==! -
NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcmod.F90
r12015 r12063 127 127 IF( lk_cice ) nn_ice = 3 128 128 ENDIF 129 #else 130 !IF( lk_si3 ) nn_ice = 2 131 IF( lk_cice ) nn_ice = 3 129 !!GS: TBD 130 !#else 131 ! IF( lk_si3 ) nn_ice = 2 132 ! IF( lk_cice ) nn_ice = 3 132 133 #endif 133 134 ! … … 250 251 fwfisf (:,:) = 0._wp ; risf_tsc (:,:,:) = 0._wp 251 252 fwfisf_b(:,:) = 0._wp ; risf_tsc_b(:,:,:) = 0._wp 252 END 253 ENDIF 253 254 IF( nn_ice == 0 ) THEN !* No sea-ice in the domain : ice fraction is always zero 254 255 IF( nn_components /= jp_iam_opa ) fr_i(:,:) = 0._wp ! except for OPA in SAS-OPA coupled case -
NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcrnf.F90
r11348 r12063 439 439 ! ! - mixed upstream-centered (ln_traadv_cen2=T) 440 440 ! 441 IF 441 IF( ln_rnf_depth ) CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already', & 442 442 & 'be spread through depth by ln_rnf_depth' ) 443 443 ! -
NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbctide.F90
r10068 r12063 72 72 ! Temporarily set nsec_day to beginning of day. 73 73 nsec_day_orig = nsec_day 74 IF 74 IF( nsec_day /= NINT(0.5_wp * rdt) ) THEN 75 75 kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt 76 76 nsec_day = NINT(0.5_wp * rdt) -
NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/tideini.F90
r11348 r12063 68 68 ! 69 69 IF( ln_tide ) THEN 70 IF 70 IF(lwp) THEN 71 71 WRITE(numout,*) 72 72 WRITE(numout,*) 'tide_init : Initialization of the tidal components' … … 127 127 kt_tide = nit000 128 128 ! 129 IF 129 IF(.NOT.ln_scal_load ) rn_scal_load = 0._wp 130 130 ! 131 131 END SUBROUTINE tide_init
Note: See TracChangeset
for help on using the changeset viewer.