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 13469 for NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbcblk_algo_ncar.F90 – NEMO

Ignore:
Timestamp:
2020-09-15T12:49:18+02:00 (4 years ago)
Author:
smasson
Message:

r4_trunk: first change of DO loops for routines to be merged, see #2523

File:
1 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbcblk_algo_ncar.F90

    r13466 r13469  
    214214      !!---------------------------------------------------------------------------------- 
    215215      ! 
    216       DO jj = 1, jpj 
    217          DO ji = 1, jpi 
    218             ! 
    219             zw  = pw10(ji,jj) 
    220             zw6 = zw*zw*zw 
    221             zw6 = zw6*zw6 
    222             ! 
    223             ! When wind speed > 33 m/s => Cyclone conditions => special treatment 
    224             zgt33 = 0.5_wp + SIGN( 0.5_wp, (zw - 33._wp) )   ! If pw10 < 33. => 0, else => 1 
    225             ! 
    226             CD_N10_NCAR(ji,jj) = 1.e-3_wp * ( & 
    227                &       (1._wp - zgt33)*( 2.7_wp/zw + 0.142_wp + zw/13.09_wp - 3.14807E-10_wp*zw6) & ! wind <  33 m/s 
    228                &      +    zgt33   *      2.34_wp )                                                 ! wind >= 33 m/s 
    229             ! 
    230             CD_N10_NCAR(ji,jj) = MAX( CD_N10_NCAR(ji,jj), 0.1E-3_wp ) 
    231             ! 
    232          END DO 
    233       END DO 
     216      DO_2D_11_11 
     217         ! 
     218         zw  = pw10(ji,jj) 
     219         zw6 = zw*zw*zw 
     220         zw6 = zw6*zw6 
     221         ! 
     222         ! When wind speed > 33 m/s => Cyclone conditions => special treatment 
     223         zgt33 = 0.5_wp + SIGN( 0.5_wp, (zw - 33._wp) )   ! If pw10 < 33. => 0, else => 1 
     224         ! 
     225         CD_N10_NCAR(ji,jj) = 1.e-3_wp * ( & 
     226            &       (1._wp - zgt33)*( 2.7_wp/zw + 0.142_wp + zw/13.09_wp - 3.14807E-10_wp*zw6) & ! wind <  33 m/s 
     227            &      +    zgt33   *      2.34_wp )                                                 ! wind >= 33 m/s 
     228         ! 
     229         CD_N10_NCAR(ji,jj) = MAX( CD_N10_NCAR(ji,jj), 0.1E-3_wp ) 
     230         ! 
     231      END_2D 
    234232      ! 
    235233   END FUNCTION CD_N10_NCAR 
    … …  
    281279      REAL(wp) :: zzeta, zx2, zx, zpsi_unst, zpsi_stab,  zstab   ! local scalars 
    282280      !!---------------------------------------------------------------------------------- 
    283       DO jj = 1, jpj 
    284          DO ji = 1, jpi 
    285  
    286             zzeta = pzeta(ji,jj) 
    287             ! 
    288             zx2 = SQRT( ABS(1._wp - 16._wp*zzeta) )  ! (1 - 16z)^0.5 
    289             zx2 = MAX( zx2 , 1._wp ) 
    290             zx  = SQRT(zx2)                          ! (1 - 16z)^0.25 
    291             zpsi_unst = 2._wp*LOG( (1._wp + zx )*0.5_wp )   & 
    292                &            + LOG( (1._wp + zx2)*0.5_wp )   & 
    293                &          - 2._wp*ATAN(zx) + rpi*0.5_wp 
    294             ! 
    295             zpsi_stab = -5._wp*zzeta 
    296             ! 
    297             zstab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => zstab = 1 
    298             ! 
    299             psi_m_ncar(ji,jj) =          zstab  * zpsi_stab &  ! (zzeta > 0) Stable 
    300                &              + (1._wp - zstab) * zpsi_unst    ! (zzeta < 0) Unstable 
    301             ! 
    302          END DO 
    303       END DO 
     281      DO_2D_11_11 
     282 
     283         zzeta = pzeta(ji,jj) 
     284         ! 
     285         zx2 = SQRT( ABS(1._wp - 16._wp*zzeta) )  ! (1 - 16z)^0.5 
     286         zx2 = MAX( zx2 , 1._wp ) 
     287         zx  = SQRT(zx2)                          ! (1 - 16z)^0.25 
     288         zpsi_unst = 2._wp*LOG( (1._wp + zx )*0.5_wp )   & 
     289            &            + LOG( (1._wp + zx2)*0.5_wp )   & 
     290            &          - 2._wp*ATAN(zx) + rpi*0.5_wp 
     291         ! 
     292         zpsi_stab = -5._wp*zzeta 
     293         ! 
     294         zstab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => zstab = 1 
     295         ! 
     296         psi_m_ncar(ji,jj) =          zstab  * zpsi_stab &  ! (zzeta > 0) Stable 
     297            &              + (1._wp - zstab) * zpsi_unst    ! (zzeta < 0) Unstable 
     298         ! 
     299      END_2D 
    304300   END FUNCTION psi_m_ncar 
    305301 
    … …  
    322318      !!---------------------------------------------------------------------------------- 
    323319      ! 
    324       DO jj = 1, jpj 
    325          DO ji = 1, jpi 
    326             ! 
    327             zzeta = pzeta(ji,jj) 
    328             ! 
    329             zx2 = SQRT( ABS(1._wp - 16._wp*zzeta) )  ! (1 -16z)^0.5 
    330             zx2 = MAX( zx2 , 1._wp ) 
    331             zpsi_unst = 2._wp*LOG( 0.5_wp*(1._wp + zx2) ) 
    332             ! 
    333             zpsi_stab = -5._wp*zzeta 
    334             ! 
    335             zstab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => zstab = 1 
    336             ! 
    337             psi_h_ncar(ji,jj) =          zstab  * zpsi_stab &  ! (zzeta > 0) Stable 
    338                &              + (1._wp - zstab) * zpsi_unst    ! (zzeta < 0) Unstable 
    339             ! 
    340          END DO 
    341       END DO 
     320      DO_2D_11_11 
     321         ! 
     322         zzeta = pzeta(ji,jj) 
     323         ! 
     324         zx2 = SQRT( ABS(1._wp - 16._wp*zzeta) )  ! (1 -16z)^0.5 
     325         zx2 = MAX( zx2 , 1._wp ) 
     326         zpsi_unst = 2._wp*LOG( 0.5_wp*(1._wp + zx2) ) 
     327         ! 
     328         zpsi_stab = -5._wp*zzeta 
     329         ! 
     330         zstab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => zstab = 1 
     331         ! 
     332         psi_h_ncar(ji,jj) =          zstab  * zpsi_stab &  ! (zzeta > 0) Stable 
     333            &              + (1._wp - zstab) * zpsi_unst    ! (zzeta < 0) Unstable 
     334         ! 
     335      END_2D 
    342336   END FUNCTION psi_h_ncar 
    343337 
    … …  
    382376      !!------------------------------------------------------------------- 
    383377      ! 
    384       DO jj = 1, jpj 
    385          DO ji = 1, jpi 
    386             ! 
    387             zqa = (1._wp + rctv0*pqa(ji,jj)) 
    388             ! 
    389             ! The main concern is to know whether, the vertical turbulent flux of virtual temperature, < u' theta_v' > is estimated with: 
    390             !  a/  -u* [ theta* (1 + 0.61 q) + 0.61 theta q* ] => this is the one that seems correct! chose this one! 
    391             !                      or 
    392             !  b/  -u* [ theta*              + 0.61 theta q* ] 
    393             ! 
    394             One_on_L(ji,jj) = grav*vkarmn*( pts(ji,jj)*zqa + rctv0*ptha(ji,jj)*pqs(ji,jj) ) & 
    395                &               / MAX( pus(ji,jj)*pus(ji,jj)*ptha(ji,jj)*zqa , 1.E-9_wp ) 
    396             ! 
    397          END DO 
    398       END DO 
     378      DO_2D_11_11 
     379         ! 
     380         zqa = (1._wp + rctv0*pqa(ji,jj)) 
     381         ! 
     382         ! The main concern is to know whether, the vertical turbulent flux of virtual temperature, < u' theta_v' > is estimated with: 
     383         !  a/  -u* [ theta* (1 + 0.61 q) + 0.61 theta q* ] => this is the one that seems correct! chose this one! 
     384         !                      or 
     385         !  b/  -u* [ theta*              + 0.61 theta q* ] 
     386         ! 
     387         One_on_L(ji,jj) = grav*vkarmn*( pts(ji,jj)*zqa + rctv0*ptha(ji,jj)*pqs(ji,jj) ) & 
     388            &               / MAX( pus(ji,jj)*pus(ji,jj)*ptha(ji,jj)*zqa , 1.E-9_wp ) 
     389         ! 
     390      END_2D 
    399391      ! 
    400392      One_on_L = SIGN( MIN(ABS(One_on_L),200._wp), One_on_L ) ! (prevent FPE from stupid values over masked regions...) 
Note: See TracChangeset for help on using the changeset viewer.