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 15574 for NEMO/branches/2021/dev_r14318_RK3_stage1/tests/SWG/MY_SRC/usrdef_sbc.F90 – NEMO

Ignore:
Timestamp:
2021-12-03T20:32:50+01:00 (3 years ago)
Author:
techene
Message:

#2605 #2715 trunk merged into dev_r14318_RK3_stage1

Location:
NEMO/branches/2021/dev_r14318_RK3_stage1
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2021/dev_r14318_RK3_stage1

    • Property svn:externals

      •  

        old new  
        99 
        1010# SETTE 
        11 ^/utils/CI/sette@14244        sette 
         11^/utils/CI/sette@HEAD        sette 
         12 

  • NEMO/branches/2021/dev_r14318_RK3_stage1/tests/SWG/MY_SRC/usrdef_sbc.F90

    r13752 r15574  
    3232   PUBLIC   usrdef_sbc_ice_flx   ! routine called by icestp.F90 for ice thermo 
    3333       
     34   !! * Substitutions 
     35#  include "do_loop_substitute.h90" 
    3436   !!---------------------------------------------------------------------- 
    3537   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7072      sfx (:,:) = 0._wp 
    7173      qns (:,:) = 0._wp 
     74      qsr (:,:) = 0._wp 
    7275 
    7376      ! ---------------------------- ! 
    … …  
    8487      ztauv = - REAL( rn_tau, wp ) * SIN( rn_theta * rad )   ! N.m-2 
    8588       
    86       DO jj = 1, jpj 
    87          DO ji = 1, jpi 
    88            ! length of the domain : 2000km x 2000km  
    89            utau(ji,jj) = - ztauu * COS( rpi * gphiu(ji,jj) / 2000000._wp) 
    90            vtau(ji,jj) = - ztauv * COS( rpi * gphiv(ji,jj) / 2000000._wp) 
    91          END DO 
    92       END DO 
    93       
     89      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     90         ! length of the domain : 2000km x 2000km  
     91         utau(ji,jj) = - ztauu * COS( rpi * gphiu(ji,jj) / 2000000._wp) 
     92         vtau(ji,jj) = - ztauv * COS( rpi * gphiv(ji,jj) / 2000000._wp) 
     93      END_2D 
     94       
    9495      ! module of wind stress and wind speed at T-point 
    9596      zcoef = 1. / ( zrhoa * zcdrag )  
    96       DO jj = 2, jpjm1 
    97          DO ji = 2, jpim1 
    98             ztx = utau(ji-1,jj  ) + utau(ji,jj)  
    99             zty = vtau(ji  ,jj-1) + vtau(ji,jj)  
    100             zmod = 0.5 * SQRT( ztx * ztx + zty * zty ) 
    101             taum(ji,jj) = zmod 
    102             wndm(ji,jj) = SQRT( zmod * zcoef ) 
    103          END DO 
    104       END DO 
    105        
    106       CALL lbc_lnk_multi( 'usrdef_sbc', taum(:,:), 'T', 1. , wndm(:,:), 'T', 1. ) 
     97      DO_2D( 0, 0, 0, 0 ) 
     98         ztx = utau(ji-1,jj  ) + utau(ji,jj)  
     99         zty = vtau(ji  ,jj-1) + vtau(ji,jj)  
     100         zmod = 0.5 * SQRT( ztx * ztx + zty * zty ) 
     101         taum(ji,jj) = zmod 
     102         wndm(ji,jj) = SQRT( zmod * zcoef ) 
     103      END_2D 
     104      CALL lbc_lnk( 'usrdef_sbc', taum(:,:), 'T', 1. , wndm(:,:), 'T', 1. ) 
    107105      ! 
    108106   END SUBROUTINE usrdef_sbc_oce 
Note: See TracChangeset for help on using the changeset viewer.