New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 14644 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcblk.F90 – NEMO

Ignore:
Timestamp:
2021-03-26T15:33:49+01:00 (3 years ago)
Author:
sparonuz
Message:

Merge trunk -r14642:HEAD

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  
        99 
        1010# SETTE 
        11 ^/utils/CI/sette_wave@13990         sette 
         11^/utils/CI/sette@14244        sette 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcblk.F90

    r14219 r14644  
    4040   USE sbcdcy         ! surface boundary condition: diurnal cycle 
    4141   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 
    4343   ! 
    4444#if defined key_si3 
    … …  
    348348      !                                      !- fill the bulk structure with namelist informations 
    349349      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 
    350353      ! 
    351354      DO jfpr= 1, jpfld 
    … …  
    501504      !!---------------------------------------------------------------------- 
    502505      REAL(wp), DIMENSION(jpi,jpj) ::   zssq, zcd_du, zsen, zlat, zevp 
    503       REAL(wp) :: ztmp 
     506      REAL(wp) :: ztst 
     507      LOGICAL  :: llerr 
    504508      !!---------------------------------------------------------------------- 
    505509      ! 
    … …  
    508512      ! Sanity/consistence test on humidity at first time step to detect potential screw-up: 
    509513      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 ) 
    537539      !                                            ! compute the surface ocean fluxes using bulk formulea 
    538540      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
    … …  
    620622      !!--------------------------------------------------------------------- 
    621623      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] 
    624626      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqair  ! specific humidity at T-points            [kg/kg] 
    625627      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   ptair  ! potential temperature at T-points        [Kelvin] 
    … …  
    830832 
    831833         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 ) 
    833835         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 ) 
    835837         ENDIF 
    836838 
    … …  
    10661068            pvtaui(ji,jj) = zztmp2 * ( pvtaui(ji,jj) + pvtaui(ji  ,jj+1) ) 
    10671069         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 ) 
    10691071         ! 
    10701072         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.