Changeset 14644 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcblk.F90
- Timestamp:
- 2021-03-26T15:33:49+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette _wave@13990sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcblk.F90
r14219 r14644 40 40 USE sbcdcy ! surface boundary condition: diurnal cycle 41 41 USE sbcwave , ONLY : cdn_wave ! wave module 42 USE lib_fortran ! to use key_nosignedzero 42 USE lib_fortran ! to use key_nosignedzero and glob_sum 43 43 ! 44 44 #if defined key_si3 … … 348 348 ! !- fill the bulk structure with namelist informations 349 349 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' ) 350 sf(jp_wndi )%zsgn = -1._wp ; sf(jp_wndj )%zsgn = -1._wp ! vector field at T point: overwrite default definition of zsgn 351 sf(jp_uoatm)%zsgn = -1._wp ; sf(jp_voatm)%zsgn = -1._wp ! vector field at T point: overwrite default definition of zsgn 352 sf(jp_hpgi )%zsgn = -1._wp ; sf(jp_hpgj )%zsgn = -1._wp ! vector field at T point: overwrite default definition of zsgn 350 353 ! 351 354 DO jfpr= 1, jpfld … … 501 504 !!---------------------------------------------------------------------- 502 505 REAL(wp), DIMENSION(jpi,jpj) :: zssq, zcd_du, zsen, zlat, zevp 503 REAL(wp) :: ztmp 506 REAL(wp) :: ztst 507 LOGICAL :: llerr 504 508 !!---------------------------------------------------------------------- 505 509 ! … … 508 512 ! Sanity/consistence test on humidity at first time step to detect potential screw-up: 509 513 IF( kt == nit000 ) THEN 510 IF(lwp) WRITE(numout,*) '' 511 #if defined key_agrif 512 IF(lwp) WRITE(numout,*) ' === AGRIF => Sanity/consistence test on air humidity SKIPPED! :( ===' 513 #else 514 ztmp = SUM(tmask(:,:,1)) ! number of ocean points on local proc domain 515 IF( ztmp > 8._wp ) THEN ! test only on proc domains with at least 8 ocean points! 516 ztmp = SUM(sf(jp_humi)%fnow(:,:,1)*tmask(:,:,1))/ztmp ! mean humidity over ocean on proc 517 SELECT CASE( nhumi ) 518 CASE( np_humi_sph ) ! specific humidity => expect: 0. <= something < 0.065 [kg/kg] (0.061 is saturation at 45degC !!!) 519 IF( (ztmp < 0._wp) .OR. (ztmp > 0.065) ) ztmp = -1._wp 520 CASE( np_humi_dpt ) ! dew-point temperature => expect: 110. <= something < 320. [K] 521 IF( (ztmp < 110._wp).OR.(ztmp > 320._wp) ) ztmp = -1._wp 522 CASE( np_humi_rlh ) ! relative humidity => expect: 0. <= something < 100. [%] 523 IF( (ztmp < 0._wp) .OR.(ztmp > 100._wp) ) ztmp = -1._wp 524 END SELECT 525 IF(ztmp < 0._wp) THEN 526 IF (lwp) WRITE(numout,'(" Mean humidity value found on proc #",i6.6," is: ",f10.5)') narea, ztmp 527 CALL ctl_stop( 'STOP', 'Something is wrong with air humidity!!!', & 528 & ' ==> check the unit in your input files' , & 529 & ' ==> check consistence of namelist choice: specific? relative? dew-point?', & 530 & ' ==> ln_humi_sph -> [kg/kg] | ln_humi_rlh -> [%] | ln_humi_dpt -> [K] !!!' ) 531 END IF 532 END IF 533 IF(lwp) WRITE(numout,*) ' === Sanity/consistence test on air humidity sucessfuly passed! ===' 534 #endif 535 IF(lwp) WRITE(numout,*) '' 536 END IF !IF( kt == nit000 ) 514 ! mean humidity over ocean on proc 515 ztst = glob_sum( 'sbcblk', sf(jp_humi)%fnow(:,:,1) * e1e2t(:,:) * tmask(:,:,1) ) / glob_sum( 'sbcblk', e1e2t(:,:) * tmask(:,:,1) ) 516 llerr = .FALSE. 517 SELECT CASE( nhumi ) 518 CASE( np_humi_sph ) ! specific humidity => expect: 0. <= something < 0.065 [kg/kg] (0.061 is saturation at 45degC !!!) 519 IF( (ztst < 0._wp) .OR. (ztst > 0.065_wp) ) llerr = .TRUE. 520 CASE( np_humi_dpt ) ! dew-point temperature => expect: 110. <= something < 320. [K] 521 IF( (ztst < 110._wp) .OR. (ztst > 320._wp) ) llerr = .TRUE. 522 CASE( np_humi_rlh ) ! relative humidity => expect: 0. <= something < 100. [%] 523 IF( (ztst < 0._wp) .OR. (ztst > 100._wp) ) llerr = .TRUE. 524 END SELECT 525 IF(llerr) THEN 526 WRITE(ctmp1,'(" Error on mean humidity value: ",f10.5)') ztst 527 CALL ctl_stop( 'STOP', ctmp1, 'Something is wrong with air humidity!!!', & 528 & ' ==> check the unit in your input files' , & 529 & ' ==> check consistence of namelist choice: specific? relative? dew-point?', & 530 & ' ==> ln_humi_sph -> [kg/kg] | ln_humi_rlh -> [%] | ln_humi_dpt -> [K] !!!' ) 531 ENDIF 532 IF(lwp) THEN 533 WRITE(numout,*) '' 534 WRITE(numout,*) ' Global mean humidity at kt = nit000: ', ztst 535 WRITE(numout,*) ' === Sanity/consistence test on air humidity sucessfuly passed! ===' 536 WRITE(numout,*) '' 537 ENDIF 538 ENDIF !IF( kt == nit000 ) 537 539 ! ! compute the surface ocean fluxes using bulk formulea 538 540 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN … … 620 622 !!--------------------------------------------------------------------- 621 623 INTEGER , INTENT(in ) :: kt ! time step index 622 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pwndi ! atmospheric wind at U-point [m/s]623 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pwndj ! atmospheric wind at V-point [m/s]624 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pwndi ! atmospheric wind at T-point [m/s] 625 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pwndj ! atmospheric wind at T-point [m/s] 624 626 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pqair ! specific humidity at T-points [kg/kg] 625 627 REAL(wp), INTENT(in ), DIMENSION(:,:) :: ptair ! potential temperature at T-points [Kelvin] … … 830 832 831 833 IF( ln_crt_fbk ) THEN 832 CALL lbc_lnk _multi( 'sbcblk', utau, 'U', -1._wp, vtau, 'V', -1._wp, taum, 'T', -1._wp )834 CALL lbc_lnk( 'sbcblk', utau, 'U', -1._wp, vtau, 'V', -1._wp, taum, 'T', 1._wp ) 833 835 ELSE 834 CALL lbc_lnk _multi( 'sbcblk', utau, 'U', -1._wp, vtau, 'V', -1._wp )836 CALL lbc_lnk( 'sbcblk', utau, 'U', -1._wp, vtau, 'V', -1._wp ) 835 837 ENDIF 836 838 … … 1066 1068 pvtaui(ji,jj) = zztmp2 * ( pvtaui(ji,jj) + pvtaui(ji ,jj+1) ) 1067 1069 END_2D 1068 CALL lbc_lnk _multi( 'sbcblk', putaui, 'U', -1._wp, pvtaui, 'V', -1._wp )1070 CALL lbc_lnk( 'sbcblk', putaui, 'U', -1._wp, pvtaui, 'V', -1._wp ) 1069 1071 ! 1070 1072 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=putaui , clinfo1=' blk_ice: putaui : ' &
Note: See TracChangeset
for help on using the changeset viewer.