Changeset 12098


Ignore:
Timestamp:
2019-12-06T17:12:55+01:00 (8 months ago)
Author:
laurent
Message:

Tiny fix for AGRIF to compile…

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcblk.F90

    r12074 r12098  
    2424   !!   sbc_blk_init  : initialisation of the chosen bulk formulation as ocean surface boundary condition 
    2525   !!   sbc_blk       : bulk formulation as ocean surface boundary condition 
    26    !!   blk_oce_1     : computes pieces of momentum, heat and freshwater fluxes over ocean for ABL model  (ln_abl=TRUE)   
    27    !!   blk_oce_2     : finalizes momentum, heat and freshwater fluxes computation over ocean after the ABL step  (ln_abl=TRUE)  
     26   !!   blk_oce_1     : computes pieces of momentum, heat and freshwater fluxes over ocean for ABL model  (ln_abl=TRUE) 
     27   !!   blk_oce_2     : finalizes momentum, heat and freshwater fluxes computation over ocean after the ABL step  (ln_abl=TRUE) 
    2828   !!             sea-ice case only : 
    2929   !!   blk_ice_1   : provide the air-ice stress 
     
    209209         !! Some namelist sanity tests: 
    210210         IF( ln_NCAR )      & 
    211             & CALL ctl_stop( 'sbc_blk_init: Cool-skin/warm-layer param. not compatible with NCAR algorithm' )          
     211            & CALL ctl_stop( 'sbc_blk_init: Cool-skin/warm-layer param. not compatible with NCAR algorithm' ) 
    212212         IF( nn_fsbc /= 1 ) & 
    213             & CALL ctl_stop( 'sbc_blk_init: Please set "nn_fsbc" to 1 when using cool-skin/warm-layer param.')                   
     213            & CALL ctl_stop( 'sbc_blk_init: Please set "nn_fsbc" to 1 when using cool-skin/warm-layer param.') 
    214214      END IF 
    215        
     215 
    216216      IF( ln_skin_wl ) THEN 
    217217         !! Check if the frequency of downwelling solar flux input makes sense and if ln_dm2dc=T if it is daily! 
     
    221221            & CALL ctl_stop( 'sbc_blk_init: Please set ln_dm2dc=T for warm-layer param. (ln_skin_wl) to work properly' ) 
    222222      END IF 
    223        
     223 
    224224      ioptio = 0 
    225225      IF( ln_humi_sph ) THEN 
     
    254254      slf_i(jp_slp ) = sn_slp 
    255255      IF( ln_abl ) THEN 
    256         slf_i(jp_hpgi) = sn_hpgi   ;   slf_i(jp_hpgj) = sn_hpgj   
     256         slf_i(jp_hpgi) = sn_hpgi   ;   slf_i(jp_hpgj) = sn_hpgj 
    257257      END IF 
    258258      ! 
     
    263263      DO jfpr= 1, jpfld 
    264264         ! 
    265          IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN    !--  not used field  --!   (only now allocated and set to zero)  
     265         IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN    !--  not used field  --!   (only now allocated and set to zero) 
    266266            ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 
    267             sf(jfpr)%fnow(:,:,1) = 0._wp                  
     267            sf(jfpr)%fnow(:,:,1) = 0._wp 
    268268         ELSE                                                  !-- used field  --! 
    269269            IF(   ln_abl    .AND.                                                      & 
     
    304304      ENDIF 
    305305      ! 
    306       IF( ln_abl ) THEN       ! ABL: read 3D fields for wind, temperature, humidity and pressure gradient     
     306      IF( ln_abl ) THEN       ! ABL: read 3D fields for wind, temperature, humidity and pressure gradient 
    307307         rn_zqt = ght_abl(2)          ! set the bulk altitude to ABL first level 
    308308         rn_zu  = ght_abl(2) 
     
    364364      !!              (momentum, heat, freshwater and runoff) 
    365365      !! 
    366       !! ** Method  :  
     366      !! ** Method  : 
    367367      !!              (1) READ each fluxes in NetCDF files: 
    368368      !!      the wind velocity (i-component) at z=rn_zu  (m/s) at T-point 
     
    374374      !!      the total precipitation (rain+snow)         (Kg/m2/s) 
    375375      !!      the snow (solid precipitation)              (kg/m2/s) 
    376       !!      ABL dynamical forcing (i/j-components of either hpg or geostrophic winds)  
     376      !!      ABL dynamical forcing (i/j-components of either hpg or geostrophic winds) 
    377377      !!              (2) CALL blk_oce_1 and blk_oce_2 
    378378      !! 
     
    402402      IF( kt == nit000 ) THEN 
    403403         WRITE(numout,*) '' 
     404#if defined key_agrif 
     405         WRITE(numout,*) ' === AGRIF => Sanity/consistence test on air humidity SKIPPED! :( ===' 
     406#else 
    404407         ztmp = SUM(tmask(:,:,1)) ! number of ocean points on local proc domain 
    405408         IF( ztmp > 8._wp ) THEN ! test only on proc domains with at least 8 ocean points! 
     
    422425         END IF 
    423426         WRITE(numout,*) ' === Sanity/consistence test on air humidity sucessfuly passed! ===' 
     427#endif 
    424428         WRITE(numout,*) '' 
    425429      END IF !IF( kt == nit000 ) 
    426  
    427430      !                                            ! compute the surface ocean fluxes using bulk formulea 
    428431      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
     
    432435            &                sf(jp_qsr )%fnow(:,:,1), sf(jp_qlw )%fnow(:,:,1),   &   !   <<= in (wl/cs) 
    433436            &                zssq, zcd_du, zsen, zevp )                              !   =>> out 
    434           
     437 
    435438         CALL blk_oce_2(     sf(jp_tair)%fnow(:,:,1), sf(jp_qsr )%fnow(:,:,1),   &   !   <<= in 
    436439            &                sf(jp_qlw )%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1),   &   !   <<= in 
     
    469472 
    470473   SUBROUTINE blk_oce_1( kt, pwndi, pwndj , ptair, phumi, &  ! inp 
    471               &              pslp , pst   , pu   , pv,    &  ! inp 
    472               &              pqsr , pqlw  ,               &  ! inp 
    473               &              pssq , pcd_du, psen , pevp   )  ! out 
     474      &              pslp , pst   , pu   , pv,    &  ! inp 
     475      &              pqsr , pqlw  ,               &  ! inp 
     476      &              pssq , pcd_du, psen , pevp   )  ! out 
    474477      !!--------------------------------------------------------------------- 
    475478      !!                     ***  ROUTINE blk_oce_1  *** 
     
    496499      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pu     ! surface current at U-point (i-component) [m/s] 
    497500      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pv     ! surface current at V-point (j-component) [m/s] 
    498       REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqsr   !  
    499       REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqlw   !  
     501      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqsr   ! 
     502      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqlw   ! 
    500503      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pssq   ! specific humidity at pst                 [kg/kg] 
    501504      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pcd_du ! Cd x |dU| at T-points                    [m/s] 
     
    604607      !! Time to call the user-selected bulk parameterization for 
    605608      !!  ==  transfer coefficients  ==!   Cd, Ch, Ce at T-point, and more... 
    606       SELECT CASE( nblk )         
    607  
    608          CASE( np_NCAR      ) 
    609             CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm,                              & 
    610                &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    611  
    612          CASE( np_COARE_3p0 ) 
    613             CALL turb_coare3p0 ( kt, rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, & 
    614                &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
    615                &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
    616  
    617          CASE( np_COARE_3p6 ) 
    618             CALL turb_coare3p6 ( kt, rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, & 
    619                &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
    620                &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
    621  
    622          CASE( np_ECMWF     ) 
    623             CALL turb_ecmwf   ( kt, rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl,  & 
    624                &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
    625                &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
    626  
    627          CASE DEFAULT 
     609      SELECT CASE( nblk ) 
     610 
     611      CASE( np_NCAR      ) 
     612         CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm,                              & 
     613            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
     614 
     615      CASE( np_COARE_3p0 ) 
     616         CALL turb_coare3p0 ( kt, rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, & 
     617            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
     618            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
     619 
     620      CASE( np_COARE_3p6 ) 
     621         CALL turb_coare3p6 ( kt, rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, & 
     622            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
     623            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
     624 
     625      CASE( np_ECMWF     ) 
     626         CALL turb_ecmwf   ( kt, rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl,  & 
     627            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
     628            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
     629 
     630      CASE DEFAULT 
    628631         CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' ) 
    629632 
     
    645648      !!      CALL iom_put( "Cd_oce", zcd_oce)  ! output value of pure ocean-atm. transfer coef. 
    646649      !!      CALL iom_put( "Ch_oce", zch_oce)  ! output value of pure ocean-atm. transfer coef. 
    647        
     650 
    648651      IF( ABS(rn_zu - rn_zqt) < 0.1_wp ) THEN 
    649652         !! If zu == zt, then ensuring once for all that: 
     
    651654         q_zu(:,:) = zqair(:,:) 
    652655      ENDIF 
    653        
     656 
    654657 
    655658      !  Turbulent fluxes over ocean  => BULK_FORMULA @ sbcblk_phy.F90 
    656659      ! ------------------------------------------------------------- 
    657        
     660 
    658661      IF( ln_abl ) THEN         !==  ABL formulation  ==!   multiplication by rho_air and turbulent fluxes computation done in ablstp 
    659 !! FL do we need this multiplication by tmask ... ??? 
     662         !! FL do we need this multiplication by tmask ... ??? 
    660663         DO jj = 1, jpj 
    661664            DO ji = 1, jpi 
    662665               zztmp = zU_zu(ji,jj) !* tmask(ji,jj,1) 
    663                wndm(ji,jj)   = zztmp                   ! Store zU_zu in wndm to compute ustar2 in ablmod  
     666               wndm(ji,jj)   = zztmp                   ! Store zU_zu in wndm to compute ustar2 in ablmod 
    664667               pcd_du(ji,jj) = zztmp * zcd_oce(ji,jj) 
    665668               psen(ji,jj)   = zztmp * zch_oce(ji,jj) 
    666                pevp(ji,jj)   = zztmp * zce_oce(ji,jj)        
     669               pevp(ji,jj)   = zztmp * zce_oce(ji,jj) 
    667670            END DO 
    668671         END DO 
     
    678681         taum(:,:) = taum(:,:) * tmask(:,:,1) 
    679682         pevp(:,:) = pevp(:,:) * tmask(:,:,1) 
    680           
     683 
    681684         ! Tau i and j component on T-grid points, using array "zcd_oce" as a temporary array... 
    682685         zcd_oce = 0._wp 
    683686         WHERE ( wndm > 0._wp ) zcd_oce = taum / wndm 
    684687         zwnd_i = zcd_oce * zwnd_i 
    685          zwnd_j = zcd_oce * zwnd_j       
     688         zwnd_j = zcd_oce * zwnd_j 
    686689 
    687690         CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    688     
     691 
    689692         ! ... utau, vtau at U- and V_points, resp. 
    690693         !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 
     
    718721 
    719722   SUBROUTINE blk_oce_2( ptair, pqsr, pqlw, pprec,   &   ! <<= in 
    720               &          psnow, pst , psen, pevp     )   ! <<= in 
     723      &          psnow, pst , psen, pevp     )   ! <<= in 
    721724      !!--------------------------------------------------------------------- 
    722725      !!                     ***  ROUTINE blk_oce_2  *** 
    723726      !! 
    724       !! ** Purpose :   finalize the momentum, heat and freshwater fluxes computation  
    725       !!                at the ocean surface at each time step knowing Cd, Ch, Ce and  
     727      !! ** Purpose :   finalize the momentum, heat and freshwater fluxes computation 
     728      !!                at the ocean surface at each time step knowing Cd, Ch, Ce and 
    726729      !!                atmospheric variables (from ABL or external data) 
    727730      !! 
     
    829832   END SUBROUTINE blk_oce_2 
    830833 
    831     
     834 
    832835#if defined key_si3 
    833836   !!---------------------------------------------------------------------- 
     
    856859      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndj   ! atmospheric wind at T-point [m/s] 
    857860      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   ptair   ! atmospheric wind at T-point [m/s] 
    858       REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   phumi   ! atmospheric wind at T-point [m/s]       
     861      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   phumi   ! atmospheric wind at T-point [m/s] 
    859862      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   puice   ! sea-ice velocity on I or C grid [m/s] 
    860863      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pvice   ! " 
     
    865868      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pevpi   ! if ln_abl 
    866869      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pssqi   ! if ln_abl 
    867       REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pcd_dui ! if ln_abl  
     870      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pcd_dui ! if ln_abl 
    868871      ! 
    869872      INTEGER  ::   ji, jj    ! dummy loop indices 
     
    894897         Ce_ice(:,:) = Cd_ice(:,:) 
    895898      ELSEIF( ln_Cd_L15 ) THEN   ! calculate new drag from Lupkes(2015) equations 
    896          CALL Cdn10_Lupkes2015( ptsui, pslp, Cd_ice, Ch_ice )  
     899         CALL Cdn10_Lupkes2015( ptsui, pslp, Cd_ice, Ch_ice ) 
    897900         Ce_ice(:,:) = Ch_ice(:,:)       ! sensible and latent heat transfer coef. are considered identical 
    898901      ENDIF 
     
    904907      !IF (ln_abl) rhoa  (:,:)  = rho_air( ptair(:,:), phumi(:,:), pslp(:,:) ) !!GS: rhoa must be (re)computed here with ABL to avoid division by zero after (TBI) 
    905908      zcd_dui(:,:) = wndm_ice(:,:) * Cd_ice(:,:) 
    906        
    907       IF( ln_blk ) THEN  
     909 
     910      IF( ln_blk ) THEN 
    908911         ! ------------------------------------------------------------ ! 
    909912         !    Wind stress relative to the moving ice ( U10m - U_ice )   ! 
     
    926929      ELSE 
    927930         zztmp1 = 11637800.0_wp 
    928     zztmp2 =    -5897.8_wp 
     931        zztmp2 =    -5897.8_wp 
    929932         DO jj = 1, jpj 
    930933            DO ji = 1, jpi 
     
    10821085      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
    10831086      qprec_ice(:,:) = rhos * ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 
    1084        
     1087 
    10851088      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- 
    10861089      DO jl = 1, jpl 
     
    12561259      ! ice-atm drag 
    12571260      pcd(:,:) = rCd_ice +  &                                                         ! pure ice drag 
    1258           &      zCe     * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)  ! change due to sea-ice morphology 
     1261         &      zCe     * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)  ! change due to sea-ice morphology 
    12591262 
    12601263   END SUBROUTINE Cdn10_Lupkes2012 
     
    13651368            ! Momentum Transfert Coefficients (Eq. 38) 
    13661369            pcd(ji,jj) = zCdn_skin_ice *   zfmi +  & 
    1367                 &        zCdn_form_ice * ( zfmi * at_i_b(ji,jj) + zfmw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) ) 
     1370               &        zCdn_form_ice * ( zfmi * at_i_b(ji,jj) + zfmw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) ) 
    13681371 
    13691372            ! Heat Transfert Coefficients (Eq. 49) 
    13701373            pch(ji,jj) = zChn_skin_ice *   zfhi +  & 
    1371                 &        zChn_form_ice * ( zfhi * at_i_b(ji,jj) + zfhw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) ) 
     1374               &        zChn_form_ice * ( zfhi * at_i_b(ji,jj) + zfhw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) ) 
    13721375            ! 
    13731376         END DO 
Note: See TracChangeset for help on using the changeset viewer.